Theory Heap_Time_Monad
section ‹A monad with a polymorphic heap and time and primitive reasoning infrastructure›
text ‹This theory is an adapted version of ‹Imperative_HOL/Heap_Time_Monad›, where the heap is
extended by time bookkeeping.›
theory Heap_Time_Monad
imports
"HOL-Imperative_HOL.Heap"
"HOL-Library.Monad_Syntax"
begin
subsection ‹The monad›
subsubsection ‹Monad construction›
text ‹Monadic heap actions either produce values
and transform the heap, or fail›
datatype 'a Heap = Heap "heap ⇒ ('a × heap × nat) option"
lemma [code, code del]:
"(Code_Evaluation.term_of :: 'a::typerep Heap ⇒ Code_Evaluation.term) = Code_Evaluation.term_of"
..
primrec execute :: "'a Heap ⇒ heap ⇒ ('a × heap × nat) option" where
[code del]: "execute (Heap f) = f"
lemma Heap_cases [case_names succeed fail]:
fixes f and h
assumes succeed: "⋀x h'. execute f h = Some (x, h') ⟹ P"
assumes fail: "execute f h = None ⟹ P"
shows P
using assms by (cases "execute f h") auto
lemma Heap_execute [simp]:
"Heap (execute f) = f" by (cases f) simp_all
lemma Heap_eqI:
"(⋀h. execute f h = execute g h) ⟹ f = g"
by (cases f, cases g) (auto simp: fun_eq_iff)
named_theorems execute_simps "simplification rules for execute"
lemma execute_Let [execute_simps]:
"execute (let x = t in f x) = (let x = t in execute (f x))"
by (simp add: Let_def)
subsubsection ‹Specialised lifters›
definition tap :: "(heap ⇒ 'a) ⇒ 'a Heap" where
[code del]: "tap f = Heap (λh. Some (f h, h, 1))"
lemma execute_tap [execute_simps]:
"execute (tap f) h = Some (f h, h, 1)"
by (simp add: tap_def)
definition heap :: "(heap ⇒ 'a × heap × nat) ⇒ 'a Heap" where
[code del]: "heap f = Heap (Some ∘ f)"
lemma execute_heap [execute_simps]:
"execute (heap f) = Some ∘ f"
by (simp add: heap_def)
definition guard :: "(heap ⇒ bool) ⇒ (heap ⇒ 'a × heap × nat) ⇒ 'a Heap" where
[code del]: "guard P f = Heap (λh. if P h then Some (f h) else None)"
lemma execute_guard [execute_simps]:
"¬ P h ⟹ execute (guard P f) h = None"
"P h ⟹ execute (guard P f) h = Some (f h)"
by (simp_all add: guard_def)
subsubsection ‹Predicate classifying successful computations›
definition success :: "'a Heap ⇒ heap ⇒ bool" where
"success f h ⟷ execute f h ≠ None"
lemma successI:
"execute f h ≠ None ⟹ success f h"
by (simp add: success_def)
lemma successE:
assumes "success f h"
obtains r h' where "execute f h = Some (r, h')"
using assms by (auto simp: success_def)
named_theorems success_intros "introduction rules for success"
lemma success_tapI [success_intros]:
"success (tap f) h"
by (rule successI) (simp add: execute_simps)
lemma success_heapI [success_intros]:
"success (heap f) h"
by (rule successI) (simp add: execute_simps)
lemma success_guardI [success_intros]:
"P h ⟹ success (guard P f) h"
by (rule successI) (simp add: execute_guard)
lemma success_LetI [success_intros]:
"x = t ⟹ success (f x) h ⟹ success (let x = t in f x) h"
by (simp add: Let_def)
lemma success_ifI:
"(c ⟹ success t h) ⟹ (¬ c ⟹ success e h) ⟹
success (if c then t else e) h"
by (simp add: success_def)
subsubsection ‹Predicate for a simple relational calculus›
text ‹
The ‹effect› vebt_predicate states that when a computation ‹c›
runs with the heap ‹h› will result in return value ‹r›
and a heap ‹h'›, i.e.~no exception occurs. AND consume time ‹n›
›
definition effect :: "'a Heap ⇒ heap ⇒ heap ⇒ 'a ⇒ nat ⇒ bool" where
effect_def: "effect c h h' r n ⟷ execute c h = Some (r, h', n)"
lemma effectI:
"execute c h = Some (r, h',n) ⟹ effect c h h' r n"
by (simp add: effect_def)
lemma effectE:
assumes "effect c h h' r n"
obtains "r = fst (the (execute c h))"
and "h' = fst (snd (the (execute c h)))"
and "n = snd (snd (the (execute c h)))"
and "success c h"
proof (rule that)
from assms have *: "execute c h = Some (r, h',n)" by (simp add: effect_def)
then show "success c h" by (simp add: success_def)
from * have "fst (the (execute c h)) = r" and "fst (snd (the (execute c h))) = h'"
and "snd (snd (the (execute c h))) = n"
by simp_all
then show "r = fst (the (execute c h))"
and "h' = fst (snd (the (execute c h)))"
and "n = snd (snd (the (execute c h)))" by simp_all
qed
lemma effect_success:
"effect c h h' r n ⟹ success c h"
by (simp add: effect_def success_def)
lemma success_effectE:
assumes "success c h"
obtains r h' n where "effect c h h' r n"
using assms by (auto simp add: effect_def success_def)
lemma effect_deterministic:
assumes "effect f h h' a n"
and "effect f h h'' b n'"
shows "a = b" and "h' = h''" and "n = n'"
using assms unfolding effect_def by auto
named_theorems effect_intros "introduction rules for effect"
and effect_elims "elimination rules for effect"
lemma effect_LetI [effect_intros]:
assumes "x = t" "effect (f x) h h' r n"
shows "effect (let x = t in f x) h h' r n"
using assms by simp
lemma effect_LetE [effect_elims]:
assumes "effect (let x = t in f x) h h' r n"
obtains "effect (f t) h h' r n"
using assms by simp
lemma effect_ifI:
assumes "c ⟹ effect t h h' r n"
and "¬ c ⟹ effect e h h' r n"
shows "effect (if c then t else e) h h' r n"
by (cases c) (simp_all add: assms)
lemma effect_ifE:
assumes "effect (if c then t else e) h h' r n"
obtains "c" "effect t h h' r n"
| "¬ c" "effect e h h' r n"
using assms by (cases c) simp_all
lemma effect_tapI [effect_intros]:
assumes "h' = h" "r = f h"
shows "effect (tap f) h h' r 1"
by (rule effectI) (simp add: assms execute_simps)
lemma effect_tapE [effect_elims]:
assumes "effect (tap f) h h' r n"
obtains "h' = h" and "r = f h" and "n=1"
using assms by (rule effectE) (auto simp add: execute_simps)
lemma effect_heapI [effect_intros]:
assumes "n = snd (snd (f h))" "h' = fst (snd (f h))" "r = fst (f h)"
shows "effect (heap f) h h' r n"
by (rule effectI) (simp add: assms execute_simps)
lemma effect_heapE [effect_elims]:
assumes "effect (heap f) h h' r n"
obtains "h' = fst (snd (f h))" and "n = snd (snd (f h))" and "r = fst (f h)"
using assms by (rule effectE) (simp add: execute_simps)
lemma effect_guardI [effect_intros]:
assumes "P h" "h' = fst (snd (f h))" "n = snd (snd (f h))" "r = fst (f h)"
shows "effect (guard P f) h h' r n"
by (rule effectI) (simp add: assms execute_simps)
lemma effect_guardE [effect_elims]:
assumes "effect (guard P f) h h' r n"
obtains "h' = fst (snd (f h))" "n = snd (snd (f h))" "r = fst (f h)" "P h"
using assms by (rule effectE)
(auto simp add: execute_simps elim!: successE, cases "P h", auto simp add: execute_simps)
subsubsection ‹Monad combinators›
definition return :: "'a ⇒ 'a Heap" where
[code del]: "return x = heap (λh. (x,h,1))"
lemma execute_return [execute_simps]:
"execute (return x) = Some ∘ (λh. (x,h,1))"
by (simp add: return_def execute_simps)
lemma success_returnI [success_intros]:
"success (return x) h"
by (rule successI) (simp add: execute_simps)
lemma effect_returnI [effect_intros]:
"h = h' ⟹ effect (return x) h h' x 1"
by (rule effectI) (simp add: execute_simps)
lemma effect_returnE [effect_elims]:
assumes "effect (return x) h h' r n"
obtains "r = x" "h' = h" "n=1"
using assms by (rule effectE) (simp add: execute_simps)
definition ureturn :: "'a ⇒ 'a Heap" where
[code del]: "ureturn x = heap (λh. (x,h,0))"
lemma execute_ureturn [execute_simps]:
"execute (ureturn x) = Some ∘ (λh. (x,h,0))"
by (simp add: ureturn_def execute_simps)
lemma success_ureturnI [success_intros]:
"success (ureturn x) h"
by (rule successI) (simp add: execute_simps)
lemma effect_ureturnI [effect_intros]:
"h = h' ⟹ effect (ureturn x) h h' x 0"
by (rule effectI) (simp add: execute_simps)
lemma effect_ureturnE [effect_elims]:
assumes "effect (ureturn x) h h' r n"
obtains "r = x" "h' = h" "n=0"
using assms by (rule effectE) (simp add: execute_simps)
definition raise :: "string ⇒ 'a Heap" where
[code del]: "raise s = Heap (λ_. None)"
lemma execute_raise [execute_simps]:
"execute (raise s) = (λ_. None)"
by (simp add: raise_def)
lemma effect_raiseE [effect_elims]:
assumes "effect (raise x) h h' r n"
obtains "False"
using assms by (rule effectE) (simp add: success_def execute_simps)
fun timeFrame :: "nat ⇒ ('a × heap × nat) option ⇒ ('a × heap × nat) option" where
"timeFrame n (Some (r,h,n')) = Some (r, h, n+n')"
| "timeFrame n None = None"
lemma timeFrame_zero[simp]: "timeFrame 0 h = h" apply(cases h) by auto
lemma timeFrame_assoc[simp]: "timeFrame n (timeFrame n' f) = timeFrame (n+n') f"
by (metis (no_types, lifting) ab_semigroup_add_class.add_ac(1) timeFrame.elims timeFrame.simps(1))
definition bind :: "'a Heap ⇒ ('a ⇒ 'b Heap) ⇒ 'b Heap" where
[code del]: "bind f g = Heap (λh. case execute f h of
Some (r, h', n) ⇒ timeFrame n (execute (g r) h')
| None ⇒ None)"
adhoc_overloading
Monad_Syntax.bind Heap_Time_Monad.bind
lemma execute_bind [execute_simps]:
"execute f h = Some (x, h',n) ⟹ execute (f ⤜ g) h = timeFrame n (execute (g x) h')"
"execute f h = None ⟹ execute (f ⤜ g) h = None"
by (simp_all add: bind_def)
lemma execute_bind_case:
"execute (f ⤜ g) h = (case (execute f h) of
Some (x, h',n) ⇒ timeFrame n (execute (g x) h') | None ⇒ None)"
by (simp add: bind_def)
lemma execute_bind_success:
"success f h ⟹ execute (f ⤜ g) h
= timeFrame (snd (snd (the (execute f h)))) (execute (g (fst (the (execute f h)))) (fst (snd (the (execute f h)))))"
by (cases f h rule: Heap_cases) (auto elim: successE simp add: bind_def)
lemma success_bind_executeI:
"execute f h = Some (x, h',n) ⟹ success (g x) h' ⟹ success (f ⤜ g) h"
by (auto intro!: successI elim: successE simp add: bind_def)
lemma success_bind_effectI [success_intros]:
"effect f h h' x n ⟹ success (g x) h' ⟹ success (f ⤜ g) h"
by (auto simp add: effect_def success_def bind_def)
lemma effect_bindI [effect_intros]:
assumes "effect f h h' r n" "effect (g r) h' h'' r' n'"
shows "effect (f ⤜ g) h h'' r' (n+n')"
using assms
apply (auto intro!: effectI elim!: effectE successE)
apply (subst execute_bind, simp_all)
apply auto
done
lemma effect_bindE [effect_elims]:
assumes "effect (f ⤜ g) h h'' r' n"
obtains h' r n1 n2 where "effect f h h' r n1" "effect (g r) h' h'' r' n2" "n = n1 + n2"
using assms apply (auto simp add: effect_def bind_def split: option.split_asm)
by (smt Pair_inject option.distinct(1) option.inject timeFrame.elims)
lemma execute_bind_eq_SomeI:
assumes "execute f h = Some (x, h',n)"
and "execute (g x) h' = Some (y, h'',n')"
shows "execute (f ⤜ g) h = Some (y, h'',n+n')"
using assms by (simp add: bind_def)
term "return x ⤜ f"
definition wait :: "nat ⇒ unit Heap" where
[execute_simps]: "wait n = Heap (λh. Some ((),h,n))"
lemma [simp]: "wait n ⤜ (%_. wait m) = wait (n+m)"
unfolding wait_def bind_def by auto
term "wait 1 ⤜ (%_. f x)"
term "return x ⤜ f"
lemma ureturn_bind [execute_simps]: "ureturn x ⤜ f = f x"
apply (rule Heap_eqI) by (simp add: execute_simps)
lemma return_bind [execute_simps]: "return x ⤜ f = (wait 1) ⪢ f x"
apply (rule Heap_eqI) by (simp add: execute_simps)
lemma bind_return [execute_simps]: "f ⤜ return = wait 1 ⪢ f"
by (rule Heap_eqI) (simp add: bind_def execute_simps split: option.splits)
lemma bind_ureturn [execute_simps]: "f ⤜ ureturn = f"
by (rule Heap_eqI) (simp add: bind_def execute_simps split: option.splits)
lemma bind_bind [simp]: "(f ⤜ g) ⤜ k = (f :: 'a Heap) ⤜ (λx. g x ⤜ k)"
by (rule Heap_eqI) (simp add: bind_def execute_simps split: option.splits)
lemma raise_bind [simp]: "raise e ⤜ f = raise e"
by (rule Heap_eqI) (simp add: execute_simps)
subsection ‹Generic combinators›
subsubsection ‹Assertions›
definition assert :: "('a ⇒ bool) ⇒ 'a ⇒ 'a Heap" where
"assert P x = (if P x then return x else raise ''assert'')"
lemma execute_assert [execute_simps]:
"P x ⟹ execute (assert P x) h = Some (x, h, 1)"
"¬ P x ⟹ execute (assert P x) h = None"
by (simp_all add: assert_def execute_simps)
lemma success_assertI [success_intros]:
"P x ⟹ success (assert P x) h"
by (rule successI) (simp add: execute_assert)
lemma effect_assertI [effect_intros]:
"P x ⟹ h' = h ⟹ r = x ⟹ n = 1 ⟹ effect (assert P x) h h' r n"
by (rule effectI) (simp add: execute_assert)
lemma effect_assertE [effect_elims]:
assumes "effect (assert P x) h h' r n"
obtains "P x" "r = x" "h' = h" "n=1"
using assms by (rule effectE) (cases "P x", simp_all add: execute_assert success_def)
lemma assert_cong [fundef_cong]:
assumes "P = P'"
assumes "⋀x. P' x ⟹ f x = f' x"
shows "(assert P x ⤜ f) = (assert P' x ⤜ f')"
by (rule Heap_eqI) (insert assms, simp add: assert_def execute_simps)
subsubsection ‹Plain lifting›
definition lift :: "('a ⇒ 'b) ⇒ 'a ⇒ 'b Heap" where
"lift f = return o f"
lemma lift_collapse [simp]:
"lift f x = return (f x)"
by (simp add: lift_def)
lemma bind_lift:
"(f ⤜ lift g) = (f ⤜ (λx. return (g x)))"
by (simp add: lift_def comp_def)
subsection ‹Partial function definition setup›
definition Heap_ord :: "'a Heap ⇒ 'a Heap ⇒ bool" where
"Heap_ord = img_ord execute (fun_ord option_ord)"
definition Heap_lub :: "'a Heap set ⇒ 'a Heap" where
"Heap_lub = img_lub execute Heap (fun_lub (flat_lub None))"
lemma Heap_lub_empty: "Heap_lub {} = Heap Map.empty"
by(simp add: Heap_lub_def img_lub_def fun_lub_def flat_lub_def)
lemma heap_interpretation: "partial_function_definitions Heap_ord Heap_lub"
proof -
have "partial_function_definitions (fun_ord option_ord) (fun_lub (flat_lub None))"
by (rule partial_function_lift) (rule flat_interpretation)
then have "partial_function_definitions (img_ord execute (fun_ord option_ord))
(img_lub execute Heap (fun_lub (flat_lub None)))"
by (rule partial_function_image) (auto intro: Heap_eqI)
then show "partial_function_definitions Heap_ord Heap_lub"
by (simp only: Heap_ord_def Heap_lub_def)
qed
interpretation heap: partial_function_definitions Heap_ord Heap_lub
rewrites "Heap_lub {} ≡ Heap Map.empty"
by (fact heap_interpretation)(simp add: Heap_lub_empty)
lemma heap_step_admissible:
"option.admissible
(λf:: 'a => ('b * 'c* 'd) option. ∀h h' r n. f h = Some (r, h',n) ⟶ P x h h' r n)"
proof (rule ccpo.admissibleI)
fix A :: "('a ⇒ ('b * 'c * 'd) option) set"
assume ch: "Complete_Partial_Order.chain option.le_fun A"
and IH: "∀f∈A. ∀h h' r n. f h = Some (r, h', n) ⟶ P x h h' r n"
from ch have ch': "⋀x. Complete_Partial_Order.chain option_ord {y. ∃f∈A. y = f x}" by (rule chain_fun)
show "∀h h' r n. option.lub_fun A h = Some (r, h', n) ⟶ P x h h' r n"
proof (intro allI impI)
fix h h' r n assume "option.lub_fun A h = Some (r, h', n)"
from flat_lub_in_chain[OF ch' this[unfolded fun_lub_def]]
have "Some (r, h', n) ∈ {y. ∃f∈A. y = f h}" by simp
then have "∃f∈A. f h = Some (r, h', n)" by auto
with IH show "P x h h' r n" by auto
qed
qed
lemma admissible_heap:
"heap.admissible (λf. ∀x h h' r n. effect (f x) h h' r n ⟶ P x h h' r n)"
proof (rule admissible_fun[OF heap_interpretation])
fix x
show "ccpo.admissible Heap_lub Heap_ord (λa. ∀h h' r n. effect a h h' r n ⟶ P x h h' r n)"
unfolding Heap_ord_def Heap_lub_def
proof (intro admissible_image partial_function_lift flat_interpretation)
show "option.admissible ((λa. ∀h h' r n. effect a h h' r n ⟶ P x h h' r n) ∘ Heap)"
unfolding comp_def effect_def execute.simps
by (rule heap_step_admissible)
qed (auto simp add: Heap_eqI)
qed
lemma fixp_induct_heap:
fixes F :: "'c ⇒ 'c" and
U :: "'c ⇒ 'b ⇒ 'a Heap" and
C :: "('b ⇒ 'a Heap) ⇒ 'c" and
P :: "'b ⇒ heap ⇒ heap ⇒ 'a ⇒ nat ⇒ bool"
assumes mono: "⋀x. monotone (fun_ord Heap_ord) Heap_ord (λf. U (F (C f)) x)"
assumes eq: "f ≡ C (ccpo.fixp (fun_lub Heap_lub) (fun_ord Heap_ord) (λf. U (F (C f))))"
assumes inverse2: "⋀f. U (C f) = f"
assumes step: "⋀f x h h' r n. (⋀x h h' r n. effect (U f x) h h' r n ⟹ P x h h' r n)
⟹ effect (U (F f) x) h h' r n ⟹ P x h h' r n"
assumes defined: "effect (U f x) h h' r n"
shows "P x h h' r n"
using step defined heap.fixp_induct_uc[of U F C, OF mono eq inverse2 admissible_heap, of P]
unfolding effect_def execute.simps
by blast
declaration ‹Partial_Function.init "heap_time" @{term heap.fixp_fun}
@{term heap.mono_body} @{thm heap.fixp_rule_uc} @{thm heap.fixp_induct_uc}
(SOME @{thm fixp_induct_heap})›
abbreviation "mono_Heap ≡ monotone (fun_ord Heap_ord) Heap_ord"
lemma Heap_ordI:
assumes "⋀h. execute x h = None ∨ execute x h = execute y h"
shows "Heap_ord x y"
using assms unfolding Heap_ord_def img_ord_def fun_ord_def flat_ord_def
by blast
lemma Heap_ordE:
assumes "Heap_ord x y"
obtains "execute x h = None" | "execute x h = execute y h"
using assms unfolding Heap_ord_def img_ord_def fun_ord_def flat_ord_def
by atomize_elim blast
lemma bind_mono [partial_function_mono]:
assumes mf: "mono_Heap B" and mg: "⋀y. mono_Heap (λf. C y f)"
shows "mono_Heap (λf. B f ⤜ (λy. C y f))"
proof (rule monotoneI)
fix f g :: "'a ⇒ 'b Heap" assume fg: "fun_ord Heap_ord f g"
from mf
have 1: "Heap_ord (B f) (B g)" by (rule monotoneD) (rule fg)
from mg
have 2: "⋀y'. Heap_ord (C y' f) (C y' g)" by (rule monotoneD) (rule fg)
have "Heap_ord (B f ⤜ (λy. C y f)) (B g ⤜ (λy. C y f))"
(is "Heap_ord ?L ?R")
proof (rule Heap_ordI)
fix h
from 1 show "execute ?L h = None ∨ execute ?L h = execute ?R h"
by (rule Heap_ordE[where h = h]) (auto simp: execute_bind_case)
qed
also
have "Heap_ord (B g ⤜ (λy'. C y' f)) (B g ⤜ (λy'. C y' g))"
(is "Heap_ord ?L ?R")
proof (rule Heap_ordI)
fix h
show "execute ?L h = None ∨ execute ?L h = execute ?R h"
proof (cases "execute (B g) h")
case None
then have "execute ?L h = None" by (auto simp: execute_bind_case)
thus ?thesis ..
next
case Some
then obtain r h' n where "execute (B g) h = Some (r, h', n)"
by (metis surjective_pairing)
then have "execute ?L h = timeFrame n (execute (C r f) h')"
"execute ?R h = timeFrame n (execute (C r g) h')"
by (auto simp: execute_bind_case)
with 2[of r] show ?thesis apply (auto elim: Heap_ordE)
by (metis Heap_ordE timeFrame.simps(2))
qed
qed
finally (heap.leq_trans)
show "Heap_ord (B f ⤜ (λy. C y f)) (B g ⤜ (λy'. C y' g))" .
qed
subsection ‹Code generator setup›
subsubsection ‹SML and OCaml›
code_printing type_constructor Heap ⇀ (SML) "(unit/ ->/ _)"
code_printing constant bind ⇀ (SML) "!(fn/ f'_/ =>/ fn/ ()/ =>/ f'_/ (_/ ())/ ())"
code_printing constant return ⇀ (SML) "!(fn/ ()/ =>/ _)"
code_printing constant Heap_Time_Monad.raise ⇀ (SML) "!(raise/ Fail/ _)"
code_printing type_constructor Heap ⇀ (OCaml) "(unit/ ->/ _)"
code_printing constant bind ⇀ (OCaml) "!(fun/ f'_/ ()/ ->/ f'_/ (_/ ())/ ())"
code_printing constant return ⇀ (OCaml) "!(fun/ ()/ ->/ _)"
code_printing constant Heap_Time_Monad.raise ⇀ (OCaml) "failwith"
subsubsection ‹Haskell›
text ‹Adaption layer›
code_printing code_module "Heap" ⇀ (Haskell)
‹import qualified Control.Monad;
import qualified Control.Monad.ST;
import qualified Data.STRef;
import qualified Data.Array.ST;
type RealWorld = Control.Monad.ST.RealWorld;
type ST s a = Control.Monad.ST.ST s a;
type STRef s a = Data.STRef.STRef s a;
type STArray s a = Data.Array.ST.STArray s Integer a;
newSTRef = Data.STRef.newSTRef;
readSTRef = Data.STRef.readSTRef;
writeSTRef = Data.STRef.writeSTRef;
newArray :: Integer -> a -> ST s (STArray s a);
newArray k = Data.Array.ST.newArray (0, k - 1);
newListArray :: [a] -> ST s (STArray s a);
newListArray xs = Data.Array.ST.newListArray (0, (fromInteger . toInteger . length) xs - 1) xs;
newFunArray :: Integer -> (Integer -> a) -> ST s (STArray s a);
newFunArray k f = Data.Array.ST.newListArray (0, k - 1) (map f [0..k-1]);
lengthArray :: STArray s a -> ST s Integer;
lengthArray a = Control.Monad.liftM (\(_, l) -> l + 1) (Data.Array.ST.getBounds a);
readArray :: STArray s a -> Integer -> ST s a;
readArray = Data.Array.ST.readArray;
writeArray :: STArray s a -> Integer -> a -> ST s ();
writeArray = Data.Array.ST.writeArray;›
code_reserved Haskell Heap
text ‹Monad›
code_printing type_constructor Heap ⇀ (Haskell) "Heap.ST/ Heap.RealWorld/ _"
code_monad bind Haskell
code_printing constant return ⇀ (Haskell) "return"
code_printing constant Heap_Time_Monad.raise ⇀ (Haskell) "error"
subsubsection ‹Scala›
code_printing code_module "Heap" ⇀ (Scala)
‹object Heap {
def bind[A, B](f: Unit => A, g: A => Unit => B): Unit => B = (_: Unit) => g (f ()) ()
}
class Ref[A](x: A) {
var value = x
}
object Ref {
def apply[A](x: A): Ref[A] =
new Ref[A](x)
def lookup[A](r: Ref[A]): A =
r.value
def update[A](r: Ref[A], x: A): Unit =
{ r.value = x }
}
object Array {
import collection.mutable.ArraySeq
def alloc[A](n: BigInt)(x: A): ArraySeq[A] =
ArraySeq.fill(n.toInt)(x)
def make[A](n: BigInt)(f: BigInt => A): ArraySeq[A] =
ArraySeq.tabulate(n.toInt)((k: Int) => f(BigInt(k)))
def len[A](a: ArraySeq[A]): BigInt =
BigInt(a.length)
def nth[A](a: ArraySeq[A], n: BigInt): A =
a(n.toInt)
def upd[A](a: ArraySeq[A], n: BigInt, x: A): Unit =
a.update(n.toInt, x)
def freeze[A](a: ArraySeq[A]): List[A] =
a.toList
}
›
code_reserved Scala Heap Ref Array
code_printing type_constructor Heap ⇀ (Scala) "(Unit/ =>/ _)"
code_printing constant bind ⇀ (Scala) "Heap.bind"
code_printing constant return ⇀ (Scala) "('_: Unit)/ =>/ _"
code_printing constant Heap_Time_Monad.raise ⇀ (Scala) "!sys.error((_))"
subsubsection ‹Target variants with less units›
setup ‹
let
open Code_Thingol;
val imp_program =
let
val is_bind = curry (op =) @{const_name bind};
val is_return = curry (op =) @{const_name return};
val dummy_name = "";
val dummy_case_term = IVar NONE;
val unitT = @{type_name unit} `%% [];
val unitt =
IConst { sym = Code_Symbol.Constant @{const_name Unity}, typargs = [], dicts = [], dom = [],
annotation = NONE };
fun dest_abs ((v, ty) `|=> t, _) = ((v, ty), t)
| dest_abs (t, ty) =
let
val vs = fold_varnames cons t [];
val v = singleton (Name.variant_list vs) "x";
val ty' = (hd o fst o unfold_fun) ty;
in ((SOME v, ty'), t `$ IVar (SOME v)) end;
fun force (t as IConst { sym = Code_Symbol.Constant c, ... } `$ t') = if is_return c
then t' else t `$ unitt
| force t = t `$ unitt;
fun tr_bind'' [(t1, _), (t2, ty2)] =
let
val ((v, ty), t) = dest_abs (t2, ty2);
in ICase { term = force t1, typ = ty, clauses = [(IVar v, tr_bind' t)], primitive = dummy_case_term } end
and tr_bind' t = case unfold_app t
of (IConst { sym = Code_Symbol.Constant c, dom = ty1 :: ty2 :: _, ... }, [x1, x2]) => if is_bind c
then tr_bind'' [(x1, ty1), (x2, ty2)]
else force t
| _ => force t;
fun imp_monad_bind'' ts = (SOME dummy_name, unitT) `|=>
ICase { term = IVar (SOME dummy_name), typ = unitT, clauses = [(unitt, tr_bind'' ts)], primitive = dummy_case_term }
fun imp_monad_bind' (const as { sym = Code_Symbol.Constant c, dom = dom, ... }) ts = if is_bind c then case (ts, dom)
of ([t1, t2], ty1 :: ty2 :: _) => imp_monad_bind'' [(t1, ty1), (t2, ty2)]
| ([t1, t2, t3], ty1 :: ty2 :: _) => imp_monad_bind'' [(t1, ty1), (t2, ty2)] `$ t3
| (ts, _) => imp_monad_bind (eta_expand 2 (const, ts))
else IConst const `$$ map imp_monad_bind ts
and imp_monad_bind (IConst const) = imp_monad_bind' const []
| imp_monad_bind (t as IVar _) = t
| imp_monad_bind (t as _ `$ _) = (case unfold_app t
of (IConst const, ts) => imp_monad_bind' const ts
| (t, ts) => imp_monad_bind t `$$ map imp_monad_bind ts)
| imp_monad_bind (v_ty `|=> t) = v_ty `|=> imp_monad_bind t
| imp_monad_bind (ICase { term = t, typ = ty, clauses = clauses, primitive = t0 }) =
ICase { term = imp_monad_bind t, typ = ty,
clauses = (map o apply2) imp_monad_bind clauses, primitive = imp_monad_bind t0 };
in (Code_Symbol.Graph.map o K o map_terms_stmt) imp_monad_bind end;
in
Code_Target.add_derived_target ("SML_imp", [("SML", imp_program)])
#> Code_Target.add_derived_target ("OCaml_imp", [("OCaml", imp_program)])
#> Code_Target.add_derived_target ("Scala_imp", [("Scala", imp_program)])
end
›
hide_const (open) Heap heap guard
lemma fold_if_return: "(if b then return c else return d) = return (if b then c else d)"
by simp
lemma distrib_if_bind: "do { x ← if b then (c::_ Heap) else d; f x } = (if b then do {x ← c; f x} else do { x←d; f x })"
by simp
lemmas heap_monad_laws = bind_return return_bind bind_bind
end
Theory Array_Time
section ‹Monadic arrays›
text ‹This theory is an adaptation of ‹HOL/Imperative_HOL/Array_Time.thy›,
adding time bookkeeping.›
theory Array_Time
imports Heap_Time_Monad
begin
subsection ‹Primitives›
definition present :: "heap ⇒ 'a::heap array ⇒ bool" where
"present h a ⟷ addr_of_array a < lim h"
definition get :: "heap ⇒ 'a::heap array ⇒ 'a list" where
"get h a = map from_nat (arrays h (TYPEREP('a)) (addr_of_array a))"
definition set :: "'a::heap array ⇒ 'a list ⇒ heap ⇒ heap" where
"set a x = arrays_update (λh. h(TYPEREP('a) := ((h(TYPEREP('a))) (addr_of_array a:=map to_nat x))))"
definition alloc :: "'a list ⇒ heap ⇒ 'a::heap array × heap" where
"alloc xs h = (let
l = lim h;
r = Array l;
h'' = set r xs (h⦇lim := l + 1⦈)
in (r, h''))"
definition length :: "heap ⇒ 'a::heap array ⇒ nat" where
"length h a = List.length (get h a)"
definition update :: "'a::heap array ⇒ nat ⇒ 'a ⇒ heap ⇒ heap" where
"update a i x h = set a ((get h a)[i:=x]) h"
definition noteq :: "'a::heap array ⇒ 'b::heap array ⇒ bool" (infix "=!!=" 70) where
"r =!!= s ⟷ TYPEREP('a) ≠ TYPEREP('b) ∨ addr_of_array r ≠ addr_of_array s"
subsection ‹Monad operations›
definition new :: "nat ⇒ 'a::heap ⇒ 'a array Heap" where
[code del]: "new n x = Heap_Time_Monad.heap (%h. let (r,h') = alloc (replicate n x) h in (r,h',n+1))"
definition of_list :: "'a::heap list ⇒ 'a array Heap" where
[code del]: "of_list xs = Heap_Time_Monad.heap (%h. let (r,h') = alloc xs h in (r,h',1+List.length xs))"
definition make :: "nat ⇒ (nat ⇒ 'a::heap) ⇒ 'a array Heap" where
[code del]: "make n f = Heap_Time_Monad.heap (%h. let (r,h') = alloc (map f [0 ..< n]) h in (r,h',n+1))"
definition len :: "'a::heap array ⇒ nat Heap" where
[code del]: "len a = Heap_Time_Monad.tap (λh. length h a)"
definition nth :: "'a::heap array ⇒ nat ⇒ 'a Heap" where
[code del]: "nth a i = Heap_Time_Monad.guard (λh. i < length h a)
(λh. (get h a ! i, h, 1))"
definition upd :: "nat ⇒ 'a ⇒ 'a::heap array ⇒ 'a::heap array Heap" where
[code del]: "upd i x a = Heap_Time_Monad.guard (λh. i < length h a)
(λh. (a, update a i x h, 1))"
definition map_entry :: "nat ⇒ ('a::heap ⇒ 'a) ⇒ 'a array ⇒ 'a array Heap" where
[code del]: "map_entry i f a = Heap_Time_Monad.guard (λh. i < length h a)
(λh. (a, update a i (f (get h a ! i)) h, 2))"
definition swap :: "nat ⇒ 'a ⇒ 'a::heap array ⇒ 'a Heap" where
[code del]: "swap i x a = Heap_Time_Monad.guard (λh. i < length h a)
(λh. (get h a ! i, update a i x h, 2 ))"
definition freeze :: "'a::heap array ⇒ 'a list Heap" where
[code del]: "freeze a = Heap_Time_Monad.heap (λh. (get h a, h, 1+length h a)) "
subsection ‹Properties›
text ‹FIXME: Does there exist a "canonical" array axiomatisation in
the literature?›
text ‹Primitives›
lemma noteq_sym: "a =!!= b ⟹ b =!!= a"
and unequal [simp]: "a ≠ a' ⟷ a =!!= a'"
unfolding noteq_def by auto
lemma noteq_irrefl: "r =!!= r ⟹ False"
unfolding noteq_def by auto
lemma present_alloc_noteq: "present h a ⟹ a =!!= fst (alloc xs h)"
by (simp add: present_def noteq_def alloc_def Let_def)
lemma get_set_eq [simp]: "get (set r x h) r = x"
by (simp add: get_def set_def o_def)
lemma get_set_neq [simp]: "r =!!= s ⟹ get (set s x h) r = get h r"
by (simp add: noteq_def get_def set_def)
lemma set_same [simp]:
"set r x (set r y h) = set r x h"
by (simp add: set_def)
lemma set_set_swap:
"r =!!= r' ⟹ set r x (set r' x' h) = set r' x' (set r x h)"
by (simp add: Let_def fun_eq_iff noteq_def set_def)
lemma get_update_eq [simp]:
"get (update a i v h) a = (get h a) [i := v]"
by (simp add: update_def)
lemma nth_update_neq [simp]:
"a =!!= b ⟹ get (update b j v h) a ! i = get h a ! i"
by (simp add: update_def noteq_def)
lemma get_update_elem_neqIndex [simp]:
"i ≠ j ⟹ get (update a j v h) a ! i = get h a ! i"
by simp
lemma length_update [simp]:
"length (update b i v h) = length h"
by (simp add: update_def length_def set_def get_def fun_eq_iff)
lemma update_swap_neq:
"a =!!= a' ⟹
update a i v (update a' i' v' h)
= update a' i' v' (update a i v h)"
apply (unfold update_def)
apply simp
apply (subst set_set_swap, assumption)
apply (subst get_set_neq)
apply (erule noteq_sym)
apply simp
done
lemma update_swap_neqIndex:
"⟦ i ≠ i' ⟧ ⟹ update a i v (update a i' v' h) = update a i' v' (update a i v h)"
by (auto simp add: update_def set_set_swap list_update_swap)
lemma get_alloc:
"get (snd (alloc xs h)) (fst (alloc ys h)) = xs"
by (simp add: Let_def split_def alloc_def)
lemma length_alloc:
"length (snd (alloc (xs :: 'a::heap list) h)) (fst (alloc (ys :: 'a list) h)) = List.length xs"
by (simp add: Array_Time.length_def get_alloc)
lemma set:
"set (fst (alloc ls h))
new_ls (snd (alloc ls h))
= snd (alloc new_ls h)"
by (simp add: Let_def split_def alloc_def)
lemma present_update [simp]:
"present (update b i v h) = present h"
by (simp add: update_def present_def set_def get_def fun_eq_iff)
lemma present_alloc [simp]:
"present (snd (alloc xs h)) (fst (alloc xs h))"
by (simp add: present_def alloc_def set_def Let_def)
lemma not_present_alloc [simp]:
"¬ present h (fst (alloc xs h))"
by (simp add: present_def alloc_def Let_def)
text ‹Monad operations›
lemma execute_new [execute_simps]:
"execute (new n x) h = Some (let (r,h') = alloc (replicate n x) h in (r,h',n+1))"
by (simp add: new_def execute_simps)
lemma success_newI [success_intros]:
"success (new n x) h"
by (auto intro: success_intros simp add: new_def)
lemma effect_newI [effect_intros]:
assumes "(a, h') = alloc (replicate n x) h"
shows "effect (new n x) h h' a (n+1)"
apply (rule effectI) apply (simp add: assms execute_simps) by (metis assms case_prod_conv)
lemma effect_newE [effect_elims]:
assumes "effect (new n x) h h' r n'"
obtains "r = fst (alloc (replicate n x) h)" "h' = snd (alloc (replicate n x) h)"
"get h' r = replicate n x" "present h' r" "¬ present h r" "n+1=n'"
using assms apply (rule effectE) using case_prod_beta get_alloc execute_new
by (metis (mono_tags, lifting) fst_conv not_present_alloc option.sel present_alloc sndI)
lemma execute_of_list [execute_simps]:
"execute (of_list xs) h = Some (let (r,h') = alloc xs h in (r,h',1 + List.length xs))"
by (simp add: of_list_def execute_simps)
lemma success_of_listI [success_intros]:
"success (of_list xs) h"
by (auto intro: success_intros simp add: of_list_def)
lemma effect_of_listI [effect_intros]:
assumes "(a, h') = alloc xs h"
shows "effect (of_list xs) h h' a (1 + List.length xs)"
by (rule effectI, simp add: assms execute_simps, metis assms case_prod_conv)
lemma effect_of_listE [effect_elims]:
assumes "effect (of_list xs) h h' r n'"
obtains "r = fst (alloc xs h)" "h' = snd (alloc xs h)"
"get h' r = xs" "present h' r" "¬ present h r" "n' = 1 + List.length xs"
using assms apply (rule effectE) apply (simp add: get_alloc execute_of_list) by (simp add: case_prod_unfold)
lemma execute_make [execute_simps]:
"execute (make n f) h = Some (let (r,h') = alloc (map f [0 ..< n]) h in (r,h',n+1))"
by (simp add: make_def execute_simps)
lemma success_makeI [success_intros]:
"success (make n f) h"
by (auto intro: success_intros simp add: make_def)
lemma effect_makeI [effect_intros]:
assumes "(a, h') = alloc (map f [0 ..< n]) h"
shows "effect (make n f) h h' a (n+1)"
by (rule effectI) (simp add: assms execute_simps, metis assms case_prod_conv)
lemma effect_makeE [effect_elims]:
assumes "effect (make n f) h h' r n'"
obtains "r = fst (alloc (map f [0 ..< n]) h)" "h' = snd (alloc (map f [0 ..< n]) h)"
"get h' r = map f [0 ..< n]" "present h' r" "¬ present h r" "n+1=n'"
using assms apply (rule effectE) using get_alloc
by (metis (mono_tags, hide_lams) effectE effect_makeI not_present_alloc present_alloc prod.collapse)
lemma execute_len [execute_simps]:
"execute (len a) h = Some (length h a, h, 1)"
by (simp add: len_def execute_simps)
lemma success_lenI [success_intros]:
"success (len a) h"
by (auto intro: success_intros simp add: len_def)
lemma effect_lengthI [effect_intros]:
assumes "h' = h" "r = length h a" "n=1"
shows "effect (len a) h h' r n"
by (rule effectI) (simp add: assms execute_simps)
lemma effect_lengthE [effect_elims]:
assumes "effect (len a) h h' r n"
obtains "r = length h' a" "h' = h" "n=1"
using assms by (rule effectE) (simp add: execute_simps)
lemma execute_nth [execute_simps]:
"i < length h a ⟹
execute (nth a i) h = Some (get h a ! i, h,1)"
"i ≥ length h a ⟹ execute (nth a i) h = None"
by (simp_all add: nth_def execute_simps)
lemma success_nthI [success_intros]:
"i < length h a ⟹ success (nth a i) h"
by (auto intro: success_intros simp add: nth_def)
lemma effect_nthI [effect_intros]:
assumes "i < length h a" "h' = h" "r = get h a ! i" "n=1"
shows "effect (nth a i) h h' r n"
by (rule effectI) (insert assms, simp add: execute_simps)
lemma effect_nthE [effect_elims]:
assumes "effect (nth a i) h h' r n"
obtains "i < length h a" "r = get h a ! i" "h' = h" "n=1"
using assms by (rule effectE) (cases "i < length h a", auto simp: execute_simps elim: successE)
lemma execute_upd [execute_simps]:
"i < length h a ⟹
execute (upd i x a) h = Some (a, update a i x h, 1)"
"i ≥ length h a ⟹ execute (upd i x a) h = None"
by (simp_all add: upd_def execute_simps)
lemma success_updI [success_intros]:
"i < length h a ⟹ success (upd i x a) h"
by (auto intro: success_intros simp add: upd_def)
lemma effect_updI [effect_intros]:
assumes "i < length h a" "h' = update a i v h" "n=1"
shows "effect (upd i v a) h h' a n"
by (rule effectI) (insert assms, simp add: execute_simps)
lemma effect_updE [effect_elims]:
assumes "effect (upd i v a) h h' r n"
obtains "r = a" "h' = update a i v h" "i < length h a" "n=1"
using assms by (rule effectE) (cases "i < length h a", auto simp: execute_simps elim: successE)
lemma execute_map_entry [execute_simps]:
"i < length h a ⟹
execute (map_entry i f a) h =
Some (a, update a i (f (get h a ! i)) h, 2)"
"i ≥ length h a ⟹ execute (map_entry i f a) h = None"
by (simp_all add: map_entry_def execute_simps)
lemma success_map_entryI [success_intros]:
"i < length h a ⟹ success (map_entry i f a) h"
by (auto intro: success_intros simp add: map_entry_def)
lemma effect_map_entryI [effect_intros]:
assumes "i < length h a" "h' = update a i (f (get h a ! i)) h" "r = a" "n=2"
shows "effect (map_entry i f a) h h' r n"
by (rule effectI) (insert assms, simp add: execute_simps)
lemma effect_map_entryE [effect_elims]:
assumes "effect (map_entry i f a) h h' r n"
obtains "r = a" "h' = update a i (f (get h a ! i)) h" "i < length h a" "n=2"
using assms by (rule effectE) (cases "i < length h a", auto simp: execute_simps elim: successE)
lemma execute_swap [execute_simps]:
"i < length h a ⟹
execute (swap i x a) h =
Some (get h a ! i, update a i x h, 2)"
"i ≥ length h a ⟹ execute (swap i x a) h = None"
by (simp_all add: swap_def execute_simps)
lemma success_swapI [success_intros]:
"i < length h a ⟹ success (swap i x a) h"
by (auto intro: success_intros simp add: swap_def)
lemma effect_swapI [effect_intros]:
assumes "i < length h a" "h' = update a i x h" "r = get h a ! i" "n=2"
shows "effect (swap i x a) h h' r n"
by (rule effectI) (insert assms, simp add: execute_simps)
lemma effect_swapE [effect_elims]:
assumes "effect (swap i x a) h h' r n"
obtains "r = get h a ! i" "h' = update a i x h" "i < length h a" "n=2"
using assms by (rule effectE) (cases "i < length h a", auto simp: execute_simps elim: successE)
lemma execute_freeze [execute_simps]:
"execute (freeze a) h = Some (get h a, h, 1+length h a)"
by (simp add: freeze_def execute_simps)
lemma success_freezeI [success_intros]:
"success (freeze a) h"
by (auto intro: success_intros simp add: freeze_def)
lemma effect_freezeI [effect_intros]:
assumes "h' = h" "r = get h a" "n=length h a"
shows "effect (freeze a) h h' r (n+1)"
by (rule effectI) (insert assms, simp add: execute_simps)
lemma effect_freezeE [effect_elims]:
assumes "effect (freeze a) h h' r n"
obtains "h' = h" "r = get h a" "n=length h a+1"
using assms by (rule effectE) (simp add: execute_simps)
lemma upd_ureturn:
"upd i x a ⪢ ureturn a = upd i x a "
by (rule Heap_eqI) (simp add: bind_def guard_def upd_def execute_simps)
lemma array_make:
"new n x = make n (λ_. x)"
by (rule Heap_eqI) (simp add: map_replicate_trivial execute_simps)
lemma array_of_list_make [code]:
"of_list xs = make (List.length xs) (λn. xs ! n)"
by (rule Heap_eqI) (simp add: map_nth execute_simps)
hide_const (open) present get set alloc length update noteq new of_list make len nth upd map_entry swap freeze
subsection ‹Code generator setup›
subsubsection ‹Logical intermediate layer›
definition new' where
[code del]: "new' = Array_Time.new o nat_of_integer"
lemma [code]:
"Array_Time.new = new' o of_nat"
by (simp add: new'_def o_def)
definition make' where
[code del]: "make' i f = Array_Time.make (nat_of_integer i) (f o of_nat)"
lemma [code]:
"Array_Time.make n f = make' (of_nat n) (f o nat_of_integer)"
by (simp add: make'_def o_def)
definition len' where
[code del]: "len' a = Array_Time.len a ⤜ (λn. ureturn (of_nat n))"
lemma [code]:
"Array_Time.len a = len' a ⤜ (λi. ureturn (nat_of_integer i))"
by (simp add: len'_def execute_simps)
definition nth' where
[code del]: "nth' a = Array_Time.nth a o nat_of_integer"
lemma [code]:
"Array_Time.nth a n = nth' a (of_nat n)"
by (simp add: nth'_def)
definition upd' where
[code del]: "upd' a i x = Array_Time.upd (nat_of_integer i) x a ⪢ ureturn ()"
lemma [code]:
"Array_Time.upd i x a = upd' a (of_nat i) x ⪢ ureturn a"
by (simp add: upd'_def upd_ureturn execute_simps)
lemma [code]:
"Array_Time.map_entry i f a = do {
x ← Array_Time.nth a i;
Array_Time.upd i (f x) a
}"
by (rule Heap_eqI) (simp add: bind_def guard_def map_entry_def execute_simps)
lemma [code]:
"Array_Time.swap i x a = do {
y ← Array_Time.nth a i;
Array_Time.upd i x a;
ureturn y
}"
by (rule Heap_eqI) (simp add: bind_def guard_def swap_def execute_simps)
hide_const (open) new' make' len' nth' upd'
text ‹SML›
code_printing type_constructor array ⇀ (SML) "_/ array"
code_printing constant Array ⇀ (SML) "raise/ (Fail/ \"bare Array\")"
code_printing constant Array_Time.new' ⇀ (SML) "(fn/ ()/ =>/ Array.array/ ((_),/ (_)))"
code_printing constant Array_Time.of_list ⇀ (SML) "(fn/ ()/ =>/ Array.fromList/ _)"
code_printing constant Array_Time.make' ⇀ (SML) "(fn/ ()/ =>/ Array.tabulate/ ((_),/ (_)))"
code_printing constant Array_Time.len' ⇀ (SML) "(fn/ ()/ =>/ Array.length/ _)"
code_printing constant Array_Time.nth' ⇀ (SML) "(fn/ ()/ =>/ Array.sub/ ((_),/ (_)))"
code_printing constant Array_Time.upd' ⇀ (SML) "(fn/ ()/ =>/ Array.update/ ((_),/ (_),/ (_)))"
code_printing constant "HOL.equal :: 'a array ⇒ 'a array ⇒ bool" ⇀ (SML) infixl 6 "="
code_reserved SML Array
text ‹OCaml›
code_printing type_constructor array ⇀ (OCaml) "_/ array"
code_printing constant Array ⇀ (OCaml) "failwith/ \"bare Array\""
code_printing constant Array_Time.new' ⇀ (OCaml) "(fun/ ()/ ->/ Array.make/ (Big'_int.int'_of'_big'_int/ _)/ _)"
code_printing constant Array_Time.of_list ⇀ (OCaml) "(fun/ ()/ ->/ Array.of'_list/ _)"
code_printing constant Array_Time.make' ⇀ (OCaml)
"(fun/ ()/ ->/ Array.init/ (Big'_int.int'_of'_big'_int/ _)/ (fun k'_ ->/ _/ (Big'_int.big'_int'_of'_int/ k'_)))"
code_printing constant Array_Time.len' ⇀ (OCaml) "(fun/ ()/ ->/ Big'_int.big'_int'_of'_int/ (Array.length/ _))"
code_printing constant Array_Time.nth' ⇀ (OCaml) "(fun/ ()/ ->/ Array.get/ _/ (Big'_int.int'_of'_big'_int/ _))"
code_printing constant Array_Time.upd' ⇀ (OCaml) "(fun/ ()/ ->/ Array.set/ _/ (Big'_int.int'_of'_big'_int/ _)/ _)"
code_printing constant "HOL.equal :: 'a array ⇒ 'a array ⇒ bool" ⇀ (OCaml) infixl 4 "="
code_reserved OCaml Array
text ‹Haskell›
code_printing type_constructor array ⇀ (Haskell) "Heap.STArray/ Heap.RealWorld/ _"
code_printing constant Array ⇀ (Haskell) "error/ \"bare Array\""
code_printing constant Array_Time.new' ⇀ (Haskell) "Heap.newArray"
code_printing constant Array_Time.of_list ⇀ (Haskell) "Heap.newListArray"
code_printing constant Array_Time.make' ⇀ (Haskell) "Heap.newFunArray"
code_printing constant Array_Time.len' ⇀ (Haskell) "Heap.lengthArray"
code_printing constant Array_Time.nth' ⇀ (Haskell) "Heap.readArray"
code_printing constant Array_Time.upd' ⇀ (Haskell) "Heap.writeArray"
code_printing constant "HOL.equal :: 'a array ⇒ 'a array ⇒ bool" ⇀ (Haskell) infix 4 "=="
code_printing class_instance array :: HOL.equal ⇀ (Haskell) -
text ‹Scala›
code_printing type_constructor array ⇀ (Scala) "!collection.mutable.ArraySeq[_]"
code_printing constant Array ⇀ (Scala) "!sys.error(\"bare Array\")"
code_printing constant Array_Time.new' ⇀ (Scala) "('_: Unit)/ => / Array.alloc((_))((_))"
code_printing constant Array_Time.make' ⇀ (Scala) "('_: Unit)/ =>/ Array.make((_))((_))"
code_printing constant Array_Time.len' ⇀ (Scala) "('_: Unit)/ =>/ Array.len((_))"
code_printing constant Array_Time.nth' ⇀ (Scala) "('_: Unit)/ =>/ Array.nth((_), (_))"
code_printing constant Array_Time.upd' ⇀ (Scala) "('_: Unit)/ =>/ Array.upd((_), (_), (_))"
code_printing constant Array_Time.freeze ⇀ (Scala) "('_: Unit)/ =>/ Array.freeze((_))"
code_printing constant "HOL.equal :: 'a array ⇒ 'a array ⇒ bool" ⇀ (Scala) infixl 5 "=="
end
Theory Heap
section ‹A polymorphic heap based on cantor encodings›
theory Heap
imports Main "HOL-Library.Countable"
begin
subsection ‹Representable types›
text ‹The type class of representable types›
class heap = typerep + countable
instance unit :: heap ..
instance bool :: heap ..
instance nat :: heap ..
instance prod :: (heap, heap) heap ..
instance sum :: (heap, heap) heap ..
instance list :: (heap) heap ..
instance option :: (heap) heap ..
instance int :: heap ..
instance String.literal :: heap ..
instance typerep :: heap ..
subsection ‹A polymorphic heap with dynamic arrays and references›
text ‹
References and arrays are developed in parallel,
but keeping them separate makes some later proofs simpler.
›
type_synonym addr = nat
type_synonym heap_rep = nat
record heap =
arrays :: "typerep ⇒ addr ⇒ heap_rep list"
refs :: "typerep ⇒ addr ⇒ heap_rep"
lim :: addr
definition empty :: heap where
"empty = ⦇arrays = (λ_ _. []), refs = (λ_ _. 0), lim = 0⦈"
datatype 'a array = Array addr
datatype 'a ref = Ref addr
primrec addr_of_array :: "'a array ⇒ addr" where
"addr_of_array (Array x) = x"
primrec addr_of_ref :: "'a ref ⇒ addr" where
"addr_of_ref (Ref x) = x"
lemma addr_of_array_inj [simp]:
"addr_of_array a = addr_of_array a' ⟷ a = a'"
by (cases a, cases a') simp_all
lemma addr_of_ref_inj [simp]:
"addr_of_ref r = addr_of_ref r' ⟷ r = r'"
by (cases r, cases r') simp_all
instance array :: (type) countable
by (rule countable_classI [of addr_of_array]) simp
instance ref :: (type) countable
by (rule countable_classI [of addr_of_ref]) simp
text ‹Syntactic convenience›
setup ‹
Sign.add_const_constraint (@{const_name Array}, SOME @{typ "nat ⇒ 'a::heap array"})
#> Sign.add_const_constraint (@{const_name Ref}, SOME @{typ "nat ⇒ 'a::heap ref"})
#> Sign.add_const_constraint (@{const_name addr_of_array}, SOME @{typ "'a::heap array ⇒ nat"})
#> Sign.add_const_constraint (@{const_name addr_of_ref}, SOME @{typ "'a::heap ref ⇒ nat"})
›
hide_const (open) empty
end
Theory Ref_Time
section ‹Monadic references›
text ‹This theory is an adaptation of ‹HOL/Imperative_HOL/Array_Time.thy›,
adding time bookkeeping.›
theory Ref_Time
imports Array_Time
begin
text ‹
Imperative reference operations; modeled after their ML counterparts.
See 🌐‹http://caml.inria.fr/pub/docs/manual-caml-light/node14.15.html›
and 🌐‹http://www.smlnj.org/doc/Conversion/top-level-comparison.html›.
›
subsection ‹Primitives›
definition present :: "heap ⇒ 'a::heap ref ⇒ bool" where
"present h r ⟷ addr_of_ref r < lim h"
definition get :: "heap ⇒ 'a::heap ref ⇒ 'a" where
"get h = from_nat ∘ refs h TYPEREP('a) ∘ addr_of_ref"
definition set :: "'a::heap ref ⇒ 'a ⇒ heap ⇒ heap" where
"set r x = refs_update
(λh. h(TYPEREP('a) := ((h (TYPEREP('a))) (addr_of_ref r := to_nat x))))"
definition alloc :: "'a ⇒ heap ⇒ 'a::heap ref × heap" where
"alloc x h = (let
l = lim h;
r = Ref l
in (r, set r x (h⦇lim := l + 1⦈)))"
definition noteq :: "'a::heap ref ⇒ 'b::heap ref ⇒ bool" (infix "=!=" 70) where
"r =!= s ⟷ TYPEREP('a) ≠ TYPEREP('b) ∨ addr_of_ref r ≠ addr_of_ref s"
subsection ‹Monad operations›
definition ref :: "'a::heap ⇒ 'a ref Heap" where
[code del]: "ref v = Heap_Time_Monad.heap (%h. let (r,h') = alloc v h in (r,h',1))"
definition lookup :: "'a::heap ref ⇒ 'a Heap" ("!_" 61) where
[code del]: "lookup r = Heap_Time_Monad.tap (λh. get h r)"
definition update :: "'a ref ⇒ 'a::heap ⇒ unit Heap" ("_ := _" 62) where
[code del]: "update r v = Heap_Time_Monad.heap (λh. ((), set r v h, 1))"
definition change :: "('a::heap ⇒ 'a) ⇒ 'a ref ⇒ 'a Heap" where
"change f r = do {
x ← ! r;
let y = f x;
r := y;
return y
}"
subsection ‹Properties›
text ‹Primitives›
lemma noteq_sym: "r =!= s ⟹ s =!= r"
and unequal [simp]: "r ≠ r' ⟷ r =!= r'"
by (auto simp add: noteq_def)
lemma noteq_irrefl: "r =!= r ⟹ False"
by (auto simp add: noteq_def)
lemma present_alloc_neq: "present h r ⟹ r =!= fst (alloc v h)"
by (simp add: present_def alloc_def noteq_def Let_def)
lemma next_fresh [simp]:
assumes "(r, h') = alloc x h"
shows "¬ present h r"
using assms by (cases h) (auto simp add: alloc_def present_def Let_def)
lemma next_present [simp]:
assumes "(r, h') = alloc x h"
shows "present h' r"
using assms by (cases h) (auto simp add: alloc_def set_def present_def Let_def)
lemma get_set_eq [simp]:
"get (set r x h) r = x"
by (simp add: get_def set_def)
lemma get_set_neq [simp]:
"r =!= s ⟹ get (set s x h) r = get h r"
by (simp add: noteq_def get_def set_def)
lemma set_same [simp]:
"set r x (set r y h) = set r x h"
by (simp add: set_def)
lemma not_present_alloc [simp]:
"¬ present h (fst (alloc v h))"
by (simp add: present_def alloc_def Let_def)
lemma set_set_swap:
"r =!= r' ⟹ set r x (set r' x' h) = set r' x' (set r x h)"
by (simp add: noteq_def set_def fun_eq_iff)
lemma alloc_set:
"fst (alloc x (set r x' h)) = fst (alloc x h)"
by (simp add: alloc_def set_def Let_def)
lemma get_alloc [simp]:
"get (snd (alloc x h)) (fst (alloc x' h)) = x"
by (simp add: alloc_def Let_def)
lemma set_alloc [simp]:
"set (fst (alloc v h)) v' (snd (alloc v h)) = snd (alloc v' h)"
by (simp add: alloc_def Let_def)
lemma get_alloc_neq: "r =!= fst (alloc v h) ⟹
get (snd (alloc v h)) r = get h r"
by (simp add: get_def set_def alloc_def Let_def noteq_def)
lemma lim_set [simp]:
"lim (set r v h) = lim h"
by (simp add: set_def)
lemma present_alloc [simp]:
"present h r ⟹ present (snd (alloc v h)) r"
by (simp add: present_def alloc_def Let_def)
lemma present_set [simp]:
"present (set r v h) = present h"
by (simp add: present_def fun_eq_iff)
lemma noteq_I:
"present h r ⟹ ¬ present h r' ⟹ r =!= r'"
by (auto simp add: noteq_def present_def)
text ‹Monad operations›
lemma execute_ref [execute_simps]:
"execute (ref v) h = Some (let (r,h') = alloc v h in (r,h',1))"
by (simp add: ref_def execute_simps)
lemma success_refI [success_intros]:
"success (ref v) h"
by (auto intro: success_intros simp add: ref_def)
lemma effect_refI [effect_intros]:
assumes "(r, h') = alloc v h" "n=1"
shows "effect (ref v) h h' r n"
apply (rule effectI) apply (insert assms, simp add: execute_simps)
by (metis case_prod_conv)
lemma effect_refE [effect_elims]:
assumes "effect (ref v) h h' r n"
obtains "get h' r = v" and "present h' r" and "¬ present h r" and "n=1"
using assms apply (rule effectE) apply (simp add: execute_simps)
by (metis (no_types, lifting) Ref_Time.alloc_def Ref_Time.get_set_eq fst_conv next_fresh next_present prod.case_eq_if snd_conv)
lemma execute_lookup [execute_simps]:
"Heap_Time_Monad.execute (lookup r) h = Some (get h r, h, 1)"
by (simp add: lookup_def execute_simps)
lemma success_lookupI [success_intros]:
"success (lookup r) h"
by (auto intro: success_intros simp add: lookup_def)
lemma effect_lookupI [effect_intros]:
assumes "h' = h" "x = get h r" "n=1"
shows "effect (!r) h h' x n"
by (rule effectI) (insert assms, simp add: execute_simps)
lemma effect_lookupE [effect_elims]:
assumes "effect (!r) h h' x n"
obtains "h' = h" "x = get h r" "n=1"
using assms by (rule effectE) (simp add: execute_simps)
lemma execute_update [execute_simps]:
"Heap_Time_Monad.execute (update r v) h = Some ((), set r v h, 1)"
by (simp add: update_def execute_simps)
lemma success_updateI [success_intros]:
"success (update r v) h"
by (auto intro: success_intros simp add: update_def)
lemma effect_updateI [effect_intros]:
assumes "h' = set r v h" "n=1"
shows "effect (r := v) h h' x n"
by (rule effectI) (insert assms, simp add: execute_simps)
lemma effect_updateE [effect_elims]:
assumes "effect (r' := v) h h' r n"
obtains "h' = set r' v h" "n=1"
using assms by (rule effectE) (simp add: execute_simps)
lemma execute_change [execute_simps]:
"Heap_Time_Monad.execute (change f r) h = Some (f (get h r), set r (f (get h r)) h, 3)"
by (simp add: change_def bind_def Let_def execute_simps)
lemma success_changeI [success_intros]:
"success (change f r) h"
by (auto intro!: success_intros effect_intros simp add: change_def)
lemma effect_changeI [effect_intros]:
assumes "h' = set r (f (get h r)) h" "x = f (get h r)" "n=3"
shows "effect (change f r) h h' x n"
by (rule effectI) (insert assms, simp add: execute_simps)
lemma effect_changeE [effect_elims]:
assumes "effect (change f r') h h' r n"
obtains "h' = set r' (f (get h r')) h" "r = f (get h r')" "n=3"
using assms by (rule effectE) (simp add: execute_simps)
lemma lookup_chain:
"(!r ⪢ f) = wait 1 ⪢ f"
by (rule Heap_eqI) (auto simp add: lookup_def execute_simps intro: execute_bind)
text ‹Non-interaction between imperative arrays and imperative references›
lemma array_get_set [simp]:
"Array_Time.get (set r v h) = Array_Time.get h"
by (simp add: Array_Time.get_def set_def fun_eq_iff)
lemma get_update [simp]:
"get (Array_Time.update a i v h) r = get h r"
by (simp add: get_def Array_Time.update_def Array_Time.set_def)
lemma alloc_update:
"fst (alloc v (Array_Time.update a i v' h)) = fst (alloc v h)"
by (simp add: Array_Time.update_def Array_Time.get_def Array_Time.set_def alloc_def Let_def)
lemma update_set_swap:
"Array_Time.update a i v (set r v' h) = set r v' (Array_Time.update a i v h)"
by (simp add: Array_Time.update_def Array_Time.get_def Array_Time.set_def set_def)
lemma length_alloc [simp]:
"Array_Time.length (snd (alloc v h)) a = Array_Time.length h a"
by (simp add: Array_Time.length_def Array_Time.get_def alloc_def set_def Let_def)
lemma array_get_alloc [simp]:
"Array_Time.get (snd (alloc v h)) = Array_Time.get h"
by (simp add: Array_Time.get_def alloc_def set_def Let_def fun_eq_iff)
lemma present_update [simp]:
"present (Array_Time.update a i v h) = present h"
by (simp add: Array_Time.update_def Array_Time.set_def fun_eq_iff present_def)
lemma array_present_set [simp]:
"Array_Time.present (set r v h) = Array_Time.present h"
by (simp add: Array_Time.present_def set_def fun_eq_iff)
lemma array_present_alloc [simp]:
"Array_Time.present h a ⟹ Array_Time.present (snd (alloc v h)) a"
by (simp add: Array_Time.present_def alloc_def Let_def)
lemma set_array_set_swap:
"Array_Time.set a xs (set r x' h) = set r x' (Array_Time.set a xs h)"
by (simp add: Array_Time.set_def set_def)
hide_const (open) present get set alloc noteq lookup update change
subsection ‹Code generator setup›
text ‹Intermediate operation avoids invariance problem in ‹Scala› (similar to value restriction)›
definition ref' where
[code del]: "ref' = ref"
lemma [code]:
"ref x = ref' x"
by (simp add: ref'_def)
text ‹SML / Eval›
code_printing type_constructor ref ⇀ (SML) "_/ ref"
code_printing type_constructor ref ⇀ (Eval) "_/ Unsynchronized.ref"
code_printing constant Ref ⇀ (SML) "raise/ (Fail/ \"bare Ref\")"
code_printing constant ref' ⇀ (SML) "(fn/ ()/ =>/ ref/ _)"
code_printing constant ref' ⇀ (Eval) "(fn/ ()/ =>/ Unsynchronized.ref/ _)"
code_printing constant Ref_Time.lookup ⇀ (SML) "(fn/ ()/ =>/ !/ _)"
code_printing constant Ref_Time.update ⇀ (SML) "(fn/ ()/ =>/ _/ :=/ _)"
code_printing constant "HOL.equal :: 'a ref ⇒ 'a ref ⇒ bool" ⇀ (SML) infixl 6 "="
code_reserved Eval Unsynchronized
text ‹OCaml›
code_printing type_constructor ref ⇀ (OCaml) "_/ ref"
code_printing constant Ref ⇀ (OCaml) "failwith/ \"bare Ref\""
code_printing constant ref' ⇀ (OCaml) "(fun/ ()/ ->/ ref/ _)"
code_printing constant Ref_Time.lookup ⇀ (OCaml) "(fun/ ()/ ->/ !/ _)"
code_printing constant Ref_Time.update ⇀ (OCaml) "(fun/ ()/ ->/ _/ :=/ _)"
code_printing constant "HOL.equal :: 'a ref ⇒ 'a ref ⇒ bool" ⇀ (OCaml) infixl 4 "="
code_reserved OCaml ref
text ‹Haskell›
code_printing type_constructor ref ⇀ (Haskell) "Heap.STRef/ Heap.RealWorld/ _"
code_printing constant Ref ⇀ (Haskell) "error/ \"bare Ref\""
code_printing constant ref' ⇀ (Haskell) "Heap.newSTRef"
code_printing constant Ref_Time.lookup ⇀ (Haskell) "Heap.readSTRef"
code_printing constant Ref_Time.update ⇀ (Haskell) "Heap.writeSTRef"
code_printing constant "HOL.equal :: 'a ref ⇒ 'a ref ⇒ bool" ⇀ (Haskell) infix 4 "=="
code_printing class_instance ref :: HOL.equal ⇀ (Haskell) -
text ‹Scala›
code_printing type_constructor ref ⇀ (Scala) "!Ref[_]"
code_printing constant Ref ⇀ (Scala) "!sys.error(\"bare Ref\")"
code_printing constant ref' ⇀ (Scala) "('_: Unit)/ =>/ Ref((_))"
code_printing constant Ref_Time.lookup ⇀ (Scala) "('_: Unit)/ =>/ Ref.lookup((_))"
code_printing constant Ref_Time.update ⇀ (Scala) "('_: Unit)/ =>/ Ref.update((_), (_))"
code_printing constant "HOL.equal :: 'a ref ⇒ 'a ref ⇒ bool" ⇀ (Scala) infixl 5 "=="
end
Theory Imperative_HOL_Time
section ‹Entry point into monadic imperative HOL with time›
theory Imperative_HOL_Time
imports Array_Time Ref_Time
begin
end
Theory Syntax_Match
section ‹Syntactic Matching in the Simplifier›
theory Syntax_Match
imports Main
begin
subsection ‹Non-Matching›
text ‹
We define the vebt_predicates ‹syntax_nomatch›
and ‹syntax_fo_nomatch›. The expression
‹syntax_nomatch pattern object› is simplified to true only if
the term ‹pattern› syntactically matches the term ‹object›.
Note that, semantically, ‹syntax_nomatch pattern object› is always
true. While ‹syntax_nomatch› does higher-order matching,
‹syntax_fo_nomatch› does first-order matching.
The intended application of these vebt_predicates are as guards for simplification
rules, enforcing additional syntactic restrictions on the applicability of
the simplification rule.
›
definition syntax_nomatch :: "'a ⇒ 'b ⇒ bool"
where syntax_nomatch_def: "syntax_nomatch pat obj ≡ True"
definition syntax_fo_nomatch :: "'a ⇒ 'b ⇒ bool"
where syntax_fo_nomatch_def: "syntax_fo_nomatch pat obj ≡ True"
lemma [cong]: "syntax_fo_nomatch x y = syntax_fo_nomatch x y" by simp
lemma [cong]: "syntax_nomatch x y = syntax_nomatch x y" by simp
ML ‹
structure Syntax_Match = struct
val nomatch_thm = @{thm syntax_nomatch_def};
val fo_nomatch_thm = @{thm syntax_fo_nomatch_def};
fun fo_nomatch_simproc ctxt credex = let
val thy = Proof_Context.theory_of ctxt;
val redex = Thm.term_of credex;
val (_,[pat,obj]) = strip_comb redex;
fun fo_matches po = (Pattern.first_order_match
thy po (Vartab.empty, Vartab.empty); true) handle Pattern.MATCH => false;
in
if fo_matches (pat,obj) then NONE else SOME fo_nomatch_thm
end
fun nomatch_simproc ctxt credex = let
val thy = Proof_Context.theory_of ctxt;
val redex = Thm.term_of credex;
val (_,[pat,obj]) = strip_comb redex;
in
if Pattern.matches thy (pat,obj) then NONE else SOME nomatch_thm
end
end
›
simproc_setup nomatch ("syntax_nomatch pat obj")
= ‹K Syntax_Match.nomatch_simproc›
simproc_setup fo_nomatch ("syntax_fo_nomatch pat obj")
= ‹K Syntax_Match.fo_nomatch_simproc›
subsection ‹Examples›
subsubsection ‹Ordering AC-structures›
text ‹
Currently, the simplifier rules for ac-rewriting only work when
associativity groups to the right. Here, we define rules that work for
associativity grouping to the left. They are useful for operators where
syntax is parsed (and pretty-printed) left-associative.
›
locale ac_operator =
fixes f
assumes right_assoc: "f (f a b) c = f a (f b c)"
assumes commute: "f a b = f b a"
begin
lemmas left_assoc = right_assoc[symmetric]
lemma left_commute: "f a (f b c) = f b (f a c)"
apply (simp add: left_assoc)
apply (simp add: commute)
done
lemmas right_ac = right_assoc left_commute commute
lemma right_commute: "f (f a b) c = f (f a c) b"
by (simp add: right_ac)
lemma safe_commute: "syntax_fo_nomatch (f x y) a ⟹ f a b = f b a"
by (simp add: right_ac)
lemmas left_ac = left_assoc right_commute safe_commute
end
interpretation mult: ac_operator "(*) ::'a::ab_semigroup_mult ⇒ _ ⇒ _"
apply unfold_locales
apply (simp_all add: ac_simps)
done
interpretation add: ac_operator "(+) ::'a::ab_semigroup_add ⇒ _ ⇒ _"
apply unfold_locales
apply (simp_all add: ac_simps)
done
text ‹Attention: ‹conj_assoc› is in standard simpset, it has to be
removed when using ‹conj.left_ac› !›
interpretation conj: ac_operator "(∧)"
by unfold_locales auto
interpretation disj: ac_operator "(∨)"
by unfold_locales auto
end
Theory Assertions
section "Assertions"
theory Assertions
imports
"../Imperative_HOL_Time/Imperative_HOL_Time"
"Tools/Syntax_Match"
Automatic_Refinement.Misc
begin
subsection ‹Partial Heaps›
text ‹
A partial heap is modeled by a heap and a set of valid addresses, with the
side condition that the valid addresses have to be within the limit of the
heap. This modeling is somewhat strange for separation logic, however, it
allows us to solve some technical problems related to definition of
Hoare triples, that will be detailed later.
›
type_synonym pheap = "heap × addr set"
text ‹Predicate that expresses that the address set of a partial heap is
within the heap's limit.
›
fun in_range :: "(heap × addr set) ⇒ bool"
where "in_range (h,as) ⟷ (∀a∈as. a < lim h)"
declare in_range.simps[simp del]
lemma in_range_empty[simp, intro!]: "in_range (h,{})"
by (auto simp: in_range.simps)
lemma in_range_dist_union[simp]:
"in_range (h,as ∪ as') ⟷ in_range (h,as) ∧ in_range (h,as')"
by (auto simp: in_range.simps)
lemma in_range_subset:
"⟦as ⊆ as'; in_range (h,as')⟧ ⟹ in_range (h,as)"
by (auto simp: in_range.simps)
text ‹Relation that holds if two heaps are identical on a given
address range›
definition relH :: "addr set ⇒ heap ⇒ heap ⇒ bool"
where "relH as h h' ≡
in_range (h,as)
∧ in_range (h',as)
∧ (∀t. ∀a ∈ as.
refs h t a = refs h' t a
∧ arrays h t a = arrays h' t a
)"
lemma relH_in_rangeI:
assumes "relH as h h'"
shows "in_range (h,as)" and "in_range (h',as)"
using assms unfolding relH_def by auto
text "Reflexivity"
lemma relH_refl: "in_range (h,as) ⟹ relH as h h"
unfolding relH_def by simp
text "Symmetry"
lemma relH_sym: "relH as h h' ⟹ relH as h' h"
unfolding relH_def
by auto
text "Transitivity"
lemma relH_trans[trans]: "⟦relH as h1 h2; relH as h2 h3⟧ ⟹ relH as h1 h3"
unfolding relH_def
by auto
lemma relH_dist_union[simp]:
"relH (as∪as') h h' ⟷ relH as h h' ∧ relH as' h h'"
unfolding relH_def
by auto
lemma relH_subset:
assumes "relH bs h h'"
assumes "as ⊆ bs"
shows "relH as h h'"
using assms unfolding relH_def by (auto intro: in_range_subset)
lemma relH_ref:
assumes "relH as h h'"
assumes "addr_of_ref r ∈ as"
shows "Ref_Time.get h r = Ref_Time.get h' r"
using assms unfolding relH_def Ref_Time.get_def by auto
lemma relH_array:
assumes "relH as h h'"
assumes "addr_of_array r ∈ as"
shows "Array_Time.get h r = Array_Time.get h' r"
using assms unfolding relH_def Array_Time.get_def by auto
lemma relH_set_ref: "⟦ addr_of_ref r ∉ as; in_range (h,as)⟧
⟹ relH as h (Ref_Time.set r x h)"
unfolding relH_def Ref_Time.set_def
by (auto simp: in_range.simps)
lemma relH_set_array: "⟦addr_of_array r ∉ as; in_range (h,as)⟧
⟹ relH as h (Array_Time.set r x h)"
unfolding relH_def Array_Time.set_def
by (auto simp: in_range.simps)
subsection ‹Assertions›
text ‹
Assertions are predicates on partial heaps, that fulfill a well-formedness
condition called properness: They only depend on the part of the heap
by the address set, and must be false for partial heaps that are not in range.
›
type_synonym assn_raw = "pheap ⇒ bool"
definition proper :: "assn_raw ⇒ bool" where
"proper P ≡ ∀h h' as. (P (h,as) ⟶ in_range (h,as))
∧ (P (h,as) ∧ relH as h h' ∧ in_range (h',as) ⟶ P (h',as))"
lemma properI[intro?]:
assumes "⋀as h. P (h,as) ⟹ in_range (h,as)"
assumes "⋀as h h'.
⟦P (h,as); relH as h h'; in_range (h',as)⟧ ⟹ P (h',as)"
shows "proper P"
unfolding proper_def using assms by blast
lemma properD1:
assumes "proper P"
assumes "P (h,as)"
shows "in_range (h,as)"
using assms unfolding proper_def by blast
lemma properD2:
assumes "proper P"
assumes "P (h,as)"
assumes "relH as h h'"
assumes "in_range (h',as)"
shows "P (h',as)"
using assms unfolding proper_def by blast
lemmas properD = properD1 properD2
lemma proper_iff:
assumes "proper P"
assumes "relH as h h'"
assumes "in_range (h',as)"
shows "P (h,as) ⟷ P (h',as)"
using assms
by (metis properD2 relH_in_rangeI(1) relH_sym)
text ‹We encapsulate assertions in their own type›
typedef assn = "Collect proper"
apply simp
unfolding proper_def
by fastforce
lemmas [simp] = Rep_assn_inverse Rep_assn_inject
lemmas [simp, intro!] = Rep_assn[unfolded mem_Collect_eq]
lemma Abs_assn_eqI[intro?]:
"(⋀h. P h = Rep_assn Pr h) ⟹ Abs_assn P = Pr"
"(⋀h. P h = Rep_assn Pr h) ⟹ Pr = Abs_assn P"
by (metis Rep_assn_inverse predicate1I xt1(5))+
abbreviation models :: "pheap ⇒ assn ⇒ bool" (infix "⊨" 50)
where "h⊨P ≡ Rep_assn P h"
lemma models_in_range: "h⊨P ⟹ in_range h"
apply (cases h)
by (metis mem_Collect_eq Rep_assn properD1)
subsubsection ‹Empty Partial Heap›
text ‹The empty partial heap satisfies some special properties.
We set up a simplification that tries to rewrite it to the standard
empty partial heap ‹h⇩⊥››
abbreviation h_bot ("h⇩⊥") where "h⇩⊥ ≡ (undefined,{})"
lemma mod_h_bot_indep: "(h,{})⊨P ⟷ (h',{})⊨P"
by (metis mem_Collect_eq Rep_assn emptyE in_range_empty
proper_iff relH_def)
lemma mod_h_bot_normalize[simp]:
"syntax_fo_nomatch undefined h ⟹ (h,{})⊨P ⟷ h⇩⊥ ⊨ P"
using mod_h_bot_indep[where h'=undefined] by simp
text ‹Properness, lifted to the assertion type.›
lemma mod_relH: "relH as h h' ⟹ (h,as)⊨P ⟷ (h',as)⊨P"
by (metis mem_Collect_eq Rep_assn proper_iff relH_in_rangeI(2))
subsection ‹Connectives›
text ‹
We define several operations on assertions, and instantiate some type classes.
›
subsubsection ‹Empty Heap and Separation Conjunction›
text ‹The assertion that describes the empty heap, and the separation
conjunction form a commutative monoid:›
instantiation assn :: one begin
fun one_assn_raw :: "pheap ⇒ bool"
where "one_assn_raw (h,as) ⟷ as={}"
lemma one_assn_proper[intro!,simp]: "proper one_assn_raw"
by (auto intro!: properI)
definition one_assn :: assn where "1 ≡ Abs_assn one_assn_raw"
instance ..
end
abbreviation one_assn::assn ("emp") where "one_assn ≡ 1"
instantiation assn :: times begin
fun times_assn_raw :: "assn_raw ⇒ assn_raw ⇒ assn_raw" where
"times_assn_raw P Q (h,as)
= (∃as1 as2. as=as1∪as2 ∧ as1∩as2={}
∧ P (h,as1) ∧ Q (h,as2))"
lemma times_assn_proper[intro!,simp]:
"proper P ⟹ proper Q ⟹ proper (times_assn_raw P Q)"
apply (rule properI)
apply (auto dest: properD1) []
apply clarsimp
apply (drule (3) properD2)
apply (drule (3) properD2)
apply blast
done
definition times_assn where "P*Q ≡
Abs_assn (times_assn_raw (Rep_assn P) (Rep_assn Q))"
instance ..
end
lemma mod_star_conv: "h⊨A*B
⟷ (∃hr as1 as2. h=(hr,as1∪as2) ∧ as1∩as2={} ∧ (hr,as1)⊨A ∧ (hr,as2)⊨B)"
unfolding times_assn_def
apply (cases h)
by (auto simp: Abs_assn_inverse)
lemma mod_starD: "h⊨A*B ⟹ ∃h1 h2. h1⊨A ∧ h2⊨B"
by (auto simp: mod_star_conv)
lemma mod_starE:
assumes "h ⊨ a*b"
obtains h⇩1 h⇩2 where "h⇩1 ⊨ a" "h⇩2 ⊨ b"
using assms by (auto dest: mod_starD)
lemma star_assnI:
assumes "(h,as)⊨P" and "(h,as')⊨Q" and "as∩as'={}"
shows "(h,as∪as')⊨P*Q"
using assms unfolding times_assn_def
by (auto simp: Abs_assn_inverse)
instantiation assn :: comm_monoid_mult begin
lemma assn_one_left: "1*P = (P::assn)"
unfolding one_assn_def times_assn_def
apply (rule)
apply (auto simp: Abs_assn_inverse)
done
lemma assn_times_comm: "P*Q = Q*(P::assn)"
unfolding times_assn_def
apply rule
apply (fastforce simp add: Abs_assn_inverse Un_ac)
done
lemma assn_times_assoc: "(P*Q)*R = P*(Q*(R::assn))"
unfolding times_assn_def
apply rule
apply (auto simp: Abs_assn_inverse)
apply (rule_tac x="as1∪as1a" in exI)
apply (rule_tac x="as2a" in exI)
apply (auto simp add: Un_ac) []
apply (rule_tac x="as1a" in exI)
apply (rule_tac x="as2a∪as2" in exI)
apply (fastforce simp add: Un_ac) []
done
instance
apply standard
apply (rule assn_times_assoc)
apply (rule assn_times_comm)
apply (rule assn_one_left)
done
end
subsubsection ‹Magic Wand›
fun wand_raw :: "assn_raw ⇒ assn_raw ⇒ assn_raw" where
"wand_raw P Q (h,as) ⟷ in_range (h,as)
∧ (∀h' as'. as∩as'={} ∧ relH as h h' ∧ in_range (h',as)
∧ P (h',as')
⟶ Q (h',as∪as'))"
lemma wand_proper[simp, intro!]: "proper (wand_raw P Q)"
apply (rule properI)
apply simp
apply (auto dest: relH_trans)
done
definition
wand_assn :: "assn ⇒ assn ⇒ assn" (infixl "-*" 56)
where "P-*Q ≡ Abs_assn (wand_raw (Rep_assn P) (Rep_assn Q))"
lemma wand_assnI:
assumes "in_range (h,as)"
assumes "⋀h' as'. ⟦
as ∩ as' = {};
relH as h h';
in_range (h',as);
(h',as')⊨Q
⟧ ⟹ (h',as∪as') ⊨ R"
shows "(h,as) ⊨ Q -* R"
using assms
unfolding wand_assn_def
apply (auto simp: Abs_assn_inverse)
done
subsubsection ‹Boolean Algebra on Assertions›
instantiation assn :: boolean_algebra begin
definition top_assn where "top ≡ Abs_assn in_range"
definition bot_assn where "bot ≡ Abs_assn (λ_. False)"
definition sup_assn where "sup P Q ≡ Abs_assn (λh. h⊨P ∨ h⊨Q)"
definition inf_assn where "inf P Q ≡ Abs_assn (λh. h⊨P ∧ h⊨Q)"
definition uminus_assn where
"-P ≡ Abs_assn (λh. in_range h ∧ ¬h⊨P)"
lemma bool_assn_proper[simp, intro!]:
"proper in_range"
"proper (λ_. False)"
"proper P ⟹ proper Q ⟹ proper (λh. P h ∨ Q h)"
"proper P ⟹ proper Q ⟹ proper (λh. P h ∧ Q h)"
"proper P ⟹ proper (λh. in_range h ∧ ¬P h)"
apply (auto
intro!: properI
intro: relH_in_rangeI
dest: properD1
simp: proper_iff)
done
text ‹(And, Or, True, False, Not) are a Boolean algebra.
Due to idiosyncrasies of the Isabelle/HOL class setup, we have to
also define a difference and an ordering:›
definition less_eq_assn where
[simp]: "(a::assn) ≤ b ≡ a = inf a b"
definition less_assn where
[simp]: "(a::assn) < b ≡ a ≤ b ∧ a≠b"
definition minus_assn where
[simp]: "(a::assn) - b ≡ inf a (-b)"
instance
apply standard
unfolding
top_assn_def bot_assn_def sup_assn_def inf_assn_def uminus_assn_def
less_eq_assn_def less_assn_def minus_assn_def
apply (auto
simp: Abs_assn_inverse conj_commute conj_ac
intro: Abs_assn_eqI models_in_range)
apply rule
apply (metis (mono_tags) Abs_assn_inverse[unfolded mem_Collect_eq]
Rep_assn[unfolded mem_Collect_eq] bool_assn_proper(4))
apply rule
apply (metis (mono_tags)
Abs_assn_inverse[unfolded mem_Collect_eq]
Rep_assn[unfolded mem_Collect_eq] bool_assn_proper(4))
apply rule
apply (simp add: Abs_assn_inverse)
apply (metis (mono_tags)
Abs_assn_inverse[unfolded mem_Collect_eq]
Rep_assn[unfolded mem_Collect_eq] bool_assn_proper(4))
done
end
text ‹We give the operations some more standard names›
abbreviation top_assn::assn ("true") where "top_assn ≡ top"
abbreviation bot_assn::assn ("false") where "bot_assn ≡ bot"
abbreviation sup_assn::"assn⇒assn⇒assn" (infixr "∨⇩A" 61)
where "sup_assn ≡ sup"
abbreviation inf_assn::"assn⇒assn⇒assn" (infixr "∧⇩A" 62)
where "inf_assn ≡ inf"
abbreviation uminus_assn::"assn ⇒ assn" ("¬⇩A _" [81] 80)
where "uminus_assn ≡ uminus"
text ‹Now we prove some relations between the Boolean algebra operations
and the (empty heap,separation conjunction) monoid›
lemma star_false_left[simp]: "false * P = false"
unfolding times_assn_def bot_assn_def
apply rule
apply (auto simp add: Abs_assn_inverse)
done
lemma star_false_right[simp]: "P * false = false"
using star_false_left by (simp add: assn_times_comm)
lemmas star_false = star_false_left star_false_right
lemma assn_basic_inequalities[simp, intro!]:
"true ≠ emp" "emp ≠ true"
"false ≠ emp" "emp ≠ false"
"true ≠ false" "false ≠ true"
subgoal
unfolding one_assn_def top_assn_def
proof (subst Abs_assn_inject; simp?)
have "in_range (⦇arrays = (λ_ _. []), refs = (λ_ _. 0), lim = 1⦈,{0})" (is "in_range ?h")
by (auto simp: in_range.simps)
moreover have "¬one_assn_raw ?h" by auto
ultimately show "in_range ≠ one_assn_raw" by auto
qed
subgoal
by (simp add: ‹true ≠ emp›)
subgoal
using star_false_left ‹true ≠ emp› by force
subgoal
by (simp add: ‹false ≠ emp›)
subgoal
by (metis inf_bot_right inf_top.right_neutral ‹true ≠ emp›)
subgoal
using ‹true ≠ false› by auto
done
subsubsection ‹Existential Quantification›
definition ex_assn :: "('a ⇒ assn) ⇒ assn" (binder "∃⇩A" 11)
where "(∃⇩Ax. P x) ≡ Abs_assn (λh. ∃x. h⊨P x)"
lemma ex_assn_proper[simp, intro!]:
"(⋀x. proper (P x)) ⟹ proper (λh. ∃x. P x h)"
by (auto intro!: properI dest: properD1 simp: proper_iff)
lemma ex_assn_const[simp]: "(∃⇩Ax. c) = c"
unfolding ex_assn_def by auto
lemma ex_one_point_gen:
"⟦⋀h x. h⊨P x ⟹ x=v⟧ ⟹ (∃⇩Ax. P x) = (P v)"
unfolding ex_assn_def
apply rule
apply auto
done
lemma ex_distrib_star: "(∃⇩Ax. P x * Q) = (∃⇩Ax. P x) * Q"
unfolding ex_assn_def times_assn_def
apply rule
apply (simp add: Abs_assn_inverse)
apply fastforce
done
lemma ex_distrib_and: "(∃⇩Ax. P x ∧⇩A Q) = (∃⇩Ax. P x) ∧⇩A Q"
unfolding ex_assn_def inf_assn_def
apply rule
apply (simp add: Abs_assn_inverse)
done
lemma ex_distrib_or: "(∃⇩Ax. P x ∨⇩A Q) = (∃⇩Ax. P x) ∨⇩A Q"
unfolding ex_assn_def sup_assn_def
apply rule
apply (auto simp add: Abs_assn_inverse)
done
lemma ex_join_or: "(∃⇩Ax. P x ∨⇩A (∃⇩Ax. Q x)) = (∃⇩Ax. P x ∨⇩A Q x)"
unfolding ex_assn_def sup_assn_def
apply rule
apply (auto simp add: Abs_assn_inverse)
done
subsubsection ‹Pure Assertions›
text ‹Pure assertions do not depend on any heap content.›
fun pure_assn_raw where "pure_assn_raw b (h,as) ⟷ as={} ∧ b"
definition pure_assn :: "bool ⇒ assn" ("↑") where
"↑b ≡ Abs_assn (pure_assn_raw b)"
lemma pure_assn_proper[simp, intro!]: "proper (pure_assn_raw b)"
by (auto intro!: properI intro: relH_in_rangeI)
lemma pure_true[simp]: "↑True = emp"
unfolding pure_assn_def one_assn_def
apply rule
apply (simp add: Abs_assn_inverse)
apply (auto)
done
lemma pure_false[simp]: "↑False = false"
unfolding pure_assn_def bot_assn_def
apply rule
apply (auto simp: Abs_assn_inverse)
done
lemma pure_assn_eq_false_iff[simp]: "↑P = false ⟷ ¬P" by auto
lemma pure_assn_eq_emp_iff[simp]: "↑P = emp ⟷ P" by (cases P) auto
lemma merge_pure_star[simp]:
"↑a * ↑b = ↑(a∧b)"
unfolding times_assn_def
apply rule
unfolding pure_assn_def
apply (simp add: Abs_assn_inverse)
apply fastforce
done
lemma merge_true_star[simp]: "true*true = true"
unfolding times_assn_def top_assn_def
apply rule
apply (simp add: Abs_assn_inverse)
apply (fastforce simp: in_range.simps)
done
lemma merge_pure_and[simp]:
"↑a ∧⇩A ↑b = ↑(a∧b)"
unfolding inf_assn_def
apply rule
unfolding pure_assn_def
apply (simp add: Abs_assn_inverse)
apply fastforce
done
lemma merge_pure_or[simp]:
"↑a ∨⇩A ↑b = ↑(a∨b)"
unfolding sup_assn_def
apply rule
unfolding pure_assn_def
apply (simp add: Abs_assn_inverse)
apply fastforce
done
lemma pure_assn_eq_conv[simp]: "↑P = ↑Q ⟷ P=Q" by auto
definition "is_pure_assn a ≡ ∃P. a=↑P"
lemma is_pure_assnE: assumes "is_pure_assn a" obtains P where "a=↑P"
using assms
by (auto simp: is_pure_assn_def)
lemma is_pure_assn_pure[simp, intro!]: "is_pure_assn (↑P)"
by (auto simp add: is_pure_assn_def)
lemma is_pure_assn_basic_simps[simp]:
"is_pure_assn false"
"is_pure_assn emp"
proof -
have "is_pure_assn (↑False)" by rule thus "is_pure_assn false" by simp
have "is_pure_assn (↑True)" by rule thus "is_pure_assn emp" by simp
qed
lemma is_pure_assn_starI[simp,intro!]:
"⟦is_pure_assn a; is_pure_assn b⟧ ⟹ is_pure_assn (a*b)"
by (auto elim!: is_pure_assnE)
subsubsection ‹Pointers›
text ‹In Imperative HOL, we have to distinguish between pointers to single
values and pointers to arrays. For both, we define assertions that
describe the part of the heap that a pointer points to.›
fun sngr_assn_raw :: "'a::heap ref ⇒ 'a ⇒ assn_raw" where
"sngr_assn_raw r x (h,as) ⟷ Ref_Time.get h r = x ∧ as = {addr_of_ref r} ∧
addr_of_ref r < lim h"
lemma sngr_assn_proper[simp, intro!]: "proper (sngr_assn_raw r x)"
apply (auto intro!: properI simp: relH_ref)
apply (simp add: in_range.simps)
apply (auto simp add: in_range.simps dest: relH_in_rangeI)
done
definition sngr_assn :: "'a::heap ref ⇒ 'a ⇒ assn" (infix "↦⇩r" 82)
where "r↦⇩rx ≡ Abs_assn (sngr_assn_raw r x)"
fun snga_assn_raw :: "'a::heap array ⇒ 'a list ⇒ assn_raw"
where "snga_assn_raw r x (h,as)
⟷ Array_Time.get h r = x ∧ as = {addr_of_array r}
∧ addr_of_array r < lim h"
lemma snga_assn_proper[simp, intro!]: "proper (snga_assn_raw r x)"
apply (auto intro!: properI simp: relH_array)
apply (simp add: in_range.simps)
apply (auto simp add: in_range.simps dest: relH_in_rangeI)
done
definition
snga_assn :: "'a::heap array ⇒ 'a list ⇒ assn" (infix "↦⇩a" 82)
where "r↦⇩aa ≡ Abs_assn (snga_assn_raw r a)"
text ‹Two disjoint parts of the heap cannot be pointed to by the
same pointer›
lemma sngr_same_false[simp]:
"p ↦⇩r x * p ↦⇩r y = false"
unfolding times_assn_def bot_assn_def sngr_assn_def
apply rule
apply (auto simp: Abs_assn_inverse)
done
lemma snga_same_false[simp]:
"p ↦⇩a x * p ↦⇩a y = false"
unfolding times_assn_def bot_assn_def snga_assn_def
apply rule
apply (auto simp: Abs_assn_inverse)
done
subsection ‹Properties of the Models-Predicate›
lemma mod_true[simp]: "h⊨true ⟷ in_range h"
unfolding top_assn_def by (simp add: Abs_assn_inverse)
lemma mod_false[simp]: "¬ h⊨false"
unfolding bot_assn_def by (simp add: Abs_assn_inverse)
lemma mod_emp: "h⊨emp ⟷ snd h = {}"
unfolding one_assn_def by (cases h) (simp add: Abs_assn_inverse)
lemma mod_emp_simp[simp]: "(h,{})⊨emp"
by (simp add: mod_emp)
lemma mod_pure[simp]: "h⊨↑b ⟷ snd h = {} ∧ b"
unfolding pure_assn_def
apply (cases h)
apply (auto simp add: Abs_assn_inverse)
done
lemma mod_ex_dist[simp]: "h⊨(∃⇩Ax. P x) ⟷ (∃x. h⊨P x)"
unfolding ex_assn_def by (auto simp: Abs_assn_inverse)
lemma mod_exI: "∃x. h⊨P x ⟹ h⊨(∃⇩Ax. P x)"
by (auto simp: mod_ex_dist)
lemma mod_exE: assumes "h⊨(∃⇩Ax. P x)" obtains x where "h⊨P x"
using assms by (auto simp: mod_ex_dist)
lemma mod_and_dist: "h⊨P∧⇩AQ ⟷ h⊨P ∧ h⊨Q"
unfolding inf_assn_def by (simp add: Abs_assn_inverse)
lemma mod_or_dist[simp]: "h⊨P∨⇩AQ ⟷ h⊨P ∨ h⊨Q"
unfolding sup_assn_def by (simp add: Abs_assn_inverse)
lemma mod_not_dist[simp]: "h⊨(¬⇩AP) ⟷ in_range h ∧ ¬ h⊨P"
unfolding uminus_assn_def by (simp add: Abs_assn_inverse)
lemma mod_pure_star_dist[simp]: "h⊨P*↑b ⟷ h⊨P ∧ b"
by (metis (full_types) mod_false mult_1_right pure_false
pure_true star_false_right)
lemmas mod_dist = mod_pure mod_pure_star_dist mod_ex_dist mod_and_dist
mod_or_dist mod_not_dist
lemma mod_star_trueI: "h⊨P ⟹ h⊨P*true"
unfolding times_assn_def top_assn_def
apply (simp add: Abs_assn_inverse)
apply (cases h)
apply auto
done
lemma mod_star_trueE': assumes "h⊨P*true" obtains h' where
"fst h' = fst h" and "snd h' ⊆ snd h" and "h'⊨P"
using assms
unfolding times_assn_def top_assn_def
apply (cases h)
apply (fastforce simp add: Abs_assn_inverse)
done
lemma mod_star_trueE: assumes "h⊨P*true" obtains h' where "h'⊨P"
using assms by (blast elim: mod_star_trueE')
lemma mod_h_bot_iff[simp]:
"(h,{}) ⊨ ↑b ⟷ b"
"(h,{}) ⊨ true"
"(h,{}) ⊨ p↦⇩rx ⟷ False"
"(h,{}) ⊨ q↦⇩ay ⟷ False"
"(h,{}) ⊨ P*Q ⟷ ((h,{}) ⊨ P) ∧ ((h,{}) ⊨ Q)"
"(h,{}) ⊨ P∧⇩AQ ⟷ ((h,{}) ⊨ P) ∧ ((h,{}) ⊨ Q)"
"(h,{}) ⊨ P∨⇩AQ ⟷ ((h,{}) ⊨ P) ∨ ((h,{}) ⊨ Q)"
"(h,{}) ⊨ (∃⇩Ax. R x) ⟷ (∃x. (h,{}) ⊨ R x)"
apply (simp add: pure_assn_def Abs_assn_inverse)
apply simp
apply (simp add: sngr_assn_def Abs_assn_inverse)
apply (simp add: snga_assn_def Abs_assn_inverse)
apply (simp add: times_assn_def Abs_assn_inverse)
apply (simp add: inf_assn_def Abs_assn_inverse)
apply (simp add: sup_assn_def Abs_assn_inverse)
apply (simp add: ex_assn_def Abs_assn_inverse)
done
subsection ‹Entailment›
definition entails :: "assn ⇒ assn ⇒ bool" (infix "⟹⇩A" 10)
where "P ⟹⇩A Q ≡ ∀h. h⊨P ⟶ h⊨Q"
lemma entailsI:
assumes "⋀h. h⊨P ⟹ h⊨Q"
shows "P ⟹⇩A Q"
using assms unfolding entails_def by auto
lemma entailsD:
assumes "P ⟹⇩A Q"
assumes "h⊨P"
shows "h⊨Q"
using assms unfolding entails_def by blast
subsubsection ‹Properties›
lemma ent_fwd:
assumes "h⊨P"
assumes "P ⟹⇩A Q"
shows "h⊨Q" using assms(2,1) by (rule entailsD)
lemma ent_refl[simp]: "P ⟹⇩A P"
by (auto simp: entailsI)
lemma ent_trans[trans]: "⟦ P ⟹⇩A Q; Q ⟹⇩AR ⟧ ⟹ P ⟹⇩A R"
by (auto intro: entailsI dest: entailsD)
lemma ent_iffI:
assumes "A⟹⇩AB"
assumes "B⟹⇩AA"
shows "A=B"
apply (subst Rep_assn_inject[symmetric])
apply (rule ext)
using assms unfolding entails_def
by blast
lemma ent_false[simp]: "false ⟹⇩A P"
by (auto intro: entailsI)
lemma ent_true[simp]: "P ⟹⇩A true"
by (auto intro!: entailsI simp: models_in_range)
lemma ent_false_iff[simp]: "(P ⟹⇩A false) ⟷ (∀h. ¬h⊨P)"
unfolding entails_def
by auto
lemma ent_pure_pre_iff[simp]: "(P*↑b ⟹⇩A Q) ⟷ (b ⟶ (P ⟹⇩A Q))"
unfolding entails_def
by (auto simp add: mod_dist)
lemma ent_pure_pre_iff_sng[simp]:
"(↑b ⟹⇩A Q) ⟷ (b ⟶ (emp ⟹⇩A Q))"
using ent_pure_pre_iff[where P=emp]
by simp
lemma ent_pure_post_iff[simp]:
"(P ⟹⇩A Q*↑b) ⟷ ((∀h. h⊨P ⟶ b) ∧ (P ⟹⇩A Q))"
unfolding entails_def
by (auto simp add: mod_dist)
lemma ent_pure_post_iff_sng[simp]:
"(P ⟹⇩A ↑b) ⟷ ((∀h. h⊨P ⟶ b) ∧ (P ⟹⇩A emp))"
using ent_pure_post_iff[where Q=emp]
by simp
lemma ent_ex_preI: "(⋀x. P x ⟹⇩A Q) ⟹ ∃⇩Ax. P x ⟹⇩A Q"
unfolding entails_def ex_assn_def
by (auto simp: Abs_assn_inverse)
lemma ent_ex_postI: "(P ⟹⇩A Q x) ⟹ P ⟹⇩A ∃⇩Ax. Q x"
unfolding entails_def ex_assn_def
by (auto simp: Abs_assn_inverse)
lemma ent_mp: "(P * (P -* Q)) ⟹⇩A Q"
apply (rule entailsI)
unfolding times_assn_def wand_assn_def
apply (clarsimp simp add: Abs_assn_inverse)
apply (drule_tac x="a" in spec)
apply (drule_tac x="as1" in spec)
apply (auto simp: Un_ac relH_refl)
done
lemma ent_star_mono: "⟦ P ⟹⇩A P'; Q ⟹⇩A Q'⟧ ⟹ P*Q ⟹⇩A P'*Q'"
unfolding entails_def times_assn_def
apply (simp add: Abs_assn_inverse)
apply metis
done
lemma ent_wandI:
assumes IMP: "Q*P ⟹⇩A R"
shows "P ⟹⇩A (Q -* R)"
unfolding entails_def
apply clarsimp
apply (rule wand_assnI)
apply (blast intro: models_in_range)
proof -
fix h as h' as'
assume "(h,as)⊨P"
and "as∩as'={}"
and "relH as h h'"
and "in_range (h',as)"
and "(h',as') ⊨ Q"
from ‹(h,as)⊨P› and ‹relH as h h'› have "(h',as)⊨P"
by (simp add: mod_relH)
with ‹(h',as') ⊨ Q› and ‹as∩as'={}› have "(h',as∪as')⊨Q*P"
by (metis star_assnI Int_commute Un_commute)
with IMP show "(h',as∪as') ⊨ R" by (blast dest: ent_fwd)
qed
lemma ent_disjI1:
assumes "P ∨⇩A Q ⟹⇩A R"
shows "P ⟹⇩A R" using assms unfolding entails_def by simp
lemma ent_disjI2:
assumes "P ∨⇩A Q ⟹⇩A R"
shows "Q ⟹⇩A R" using assms unfolding entails_def by simp
lemma ent_disjI1_direct[simp]: "A ⟹⇩A A ∨⇩A B"
by (simp add: entails_def)
lemma ent_disjI2_direct[simp]: "B ⟹⇩A A ∨⇩A B"
by (simp add: entails_def)
lemma ent_disjE: "⟦ A⟹⇩AC; B⟹⇩AC ⟧ ⟹ A∨⇩AB ⟹⇩AC"
unfolding entails_def by auto
lemma ent_conjI: "⟦ A⟹⇩AB; A⟹⇩AC ⟧ ⟹ A ⟹⇩A B ∧⇩A C"
unfolding entails_def by (auto simp: mod_and_dist)
lemma ent_conjE1: "⟦A⟹⇩AC⟧ ⟹ A∧⇩AB⟹⇩AC"
unfolding entails_def by (auto simp: mod_and_dist)
lemma ent_conjE2: "⟦B⟹⇩AC⟧ ⟹ A∧⇩AB⟹⇩AC"
unfolding entails_def by (auto simp: mod_and_dist)
lemma star_or_dist1:
"(A ∨⇩A B)*C = (A*C ∨⇩A B*C)"
apply (rule ent_iffI)
unfolding entails_def
by (auto simp add: mod_star_conv)
lemma star_or_dist2:
"C*(A ∨⇩A B) = (C*A ∨⇩A C*B)"
apply (rule ent_iffI)
unfolding entails_def
by (auto simp add: mod_star_conv)
lemmas star_or_dist = star_or_dist1 star_or_dist2
lemma ent_disjI1': "A⟹⇩AB ⟹ A⟹⇩AB∨⇩AC"
by (auto simp: entails_def star_or_dist)
lemma ent_disjI2': "A⟹⇩AC ⟹ A⟹⇩AB∨⇩AC"
by (auto simp: entails_def star_or_dist)
lemma triv_exI[simp, intro!]: "Q x ⟹⇩A ∃⇩Ax. Q x"
by (meson ent_ex_postI ent_refl)
subsubsection ‹Weak Entails›
text ‹Weakening of entails to allow arbitrary unspecified memory in conclusion›
definition entailst :: "assn ⇒ assn ⇒ bool" (infix "⟹⇩t" 10)
where "entailst A B ≡ A ⟹⇩A B * true"
lemma enttI: "A⟹⇩AB*true ⟹ A⟹⇩tB" unfolding entailst_def .
lemma enttD: "A⟹⇩tB ⟹ A⟹⇩AB*true" unfolding entailst_def .
lemma entt_trans:
"entailst A B ⟹ entailst B C ⟹ entailst A C"
unfolding entailst_def
apply (erule ent_trans)
by (metis assn_times_assoc ent_star_mono ent_true merge_true_star)
lemma entt_refl[simp, intro!]: "entailst A A"
unfolding entailst_def
by (simp add: entailsI mod_star_trueI)
lemma entt_true[simp, intro!]:
"entailst A true"
unfolding entailst_def by simp
lemma entt_emp[simp, intro!]:
"entailst A emp"
unfolding entailst_def by simp
lemma entt_star_true_simp[simp]:
"entailst A (B*true) ⟷ entailst A B"
"entailst (A*true) B ⟷ entailst A B"
unfolding entailst_def
subgoal by (auto simp: assn_times_assoc)
subgoal
apply (intro iffI)
subgoal using entails_def mod_star_trueI by blast
subgoal by (metis assn_times_assoc ent_refl ent_star_mono merge_true_star)
done
done
lemma entt_star_mono: "⟦entailst A B; entailst C D⟧ ⟹ entailst (A*C) (B*D)"
unfolding entailst_def
proof -
assume a1: "A ⟹⇩A B * true"
assume "C ⟹⇩A D * true"
then have "A * C ⟹⇩A true * B * (true * D)"
using a1 assn_times_comm ent_star_mono by force
then show "A * C ⟹⇩A B * D * true"
by (simp add: ab_semigroup_mult_class.mult.left_commute assn_times_comm)
qed
lemma entt_frame_fwd:
assumes "entailst P Q"
assumes "entailst A (P*F)"
assumes "entailst (Q*F) B"
shows "entailst A B"
using assms
by (metis entt_refl entt_star_mono entt_trans)
lemma enttI_true: "P*true ⟹⇩A Q*true ⟹ P⟹⇩tQ"
by (drule enttI) simp
lemma entt_def_true: "(P⟹⇩tQ) ≡ (P*true ⟹⇩A Q*true)"
unfolding entailst_def
apply (rule eq_reflection)
using entailst_def entt_star_true_simp(2) by auto
lemma ent_imp_entt: "P⟹⇩AQ ⟹ P⟹⇩tQ"
apply (rule enttI)
apply (erule ent_trans)
by (simp add: entailsI mod_star_trueI)
lemma entt_disjI1_direct[simp]: "A ⟹⇩t A ∨⇩A B"
by (rule ent_imp_entt[OF ent_disjI1_direct])
lemma entt_disjI2_direct[simp]: "B ⟹⇩t A ∨⇩A B"
by (rule ent_imp_entt[OF ent_disjI2_direct])
lemma entt_disjI1': "A⟹⇩tB ⟹ A⟹⇩tB∨⇩AC"
by (auto simp: entailst_def entails_def star_or_dist)
lemma entt_disjI2': "A⟹⇩tC ⟹ A⟹⇩tB∨⇩AC"
by (auto simp: entailst_def entails_def star_or_dist)
lemma entt_disjE: "⟦ A⟹⇩tM; B⟹⇩tM ⟧ ⟹ A∨⇩AB ⟹⇩t M"
using ent_disjE enttD enttI by blast
lemma entt_disjD1: "A∨⇩AB⟹⇩tC ⟹ A⟹⇩tC"
using entt_disjI1_direct entt_trans by blast
lemma entt_disjD2: "A∨⇩AB⟹⇩tC ⟹ B⟹⇩tC"
using entt_disjI2_direct entt_trans by blast
subsection ‹Precision›
text ‹
Precision rules describe that parts of an assertion may depend only on the
underlying heap. For example, the data where a pointer points to is the same
for the same heap.
›
text ‹Precision rules should have the form:
@{text [display] "∀x y. (h⊨(P x * F1) ∧⇩A (P y * F2)) ⟶ x=y"}›
definition "precise R ≡ ∀a a' h p F F'.
h ⊨ R a p * F ∧⇩A R a' p * F' ⟶ a = a'"
lemma preciseI[intro?]:
assumes "⋀a a' h p F F'. h ⊨ R a p * F ∧⇩A R a' p * F' ⟹ a = a'"
shows "precise R"
using assms unfolding precise_def by blast
lemma preciseD:
assumes "precise R"
assumes "h ⊨ R a p * F ∧⇩A R a' p * F'"
shows "a=a'"
using assms unfolding precise_def by blast
lemma preciseD':
assumes "precise R"
assumes "h ⊨ R a p * F"
assumes "h ⊨ R a' p * F'"
shows "a=a'"
apply (rule preciseD)
apply (rule assms)
apply (simp only: mod_and_dist)
apply (blast intro: assms)
done
lemma precise_extr_pure[simp]:
"precise (λx y. ↑P * R x y) ⟷ (P ⟶ precise R)"
"precise (λx y. R x y * ↑P) ⟷ (P ⟶ precise R)"
apply (cases P, (auto intro!: preciseI) [2])+
done
lemma sngr_prec: "precise (λx p. p↦⇩rx)"
apply rule
apply (clarsimp simp: mod_and_dist)
unfolding sngr_assn_def times_assn_def
apply (simp add: Abs_assn_inverse)
apply auto
done
lemma snga_prec: "precise (λx p. p↦⇩ax)"
apply rule
apply (clarsimp simp: mod_and_dist)
unfolding snga_assn_def times_assn_def
apply (simp add: Abs_assn_inverse)
apply auto
done
end
Theory Hoare_Triple
section ‹Hoare-Triples›
theory Hoare_Triple
imports Assertions
begin
text ‹In this theory, we define Hoare-Triples, which are our basic tool
for specifying properties of Imperative HOL programs.›
subsection ‹Definition›
text ‹Analyze the heap before and after executing a command, to add
the allocated addresses to the covered address range.›
definition new_addrs :: "heap ⇒ addr set ⇒ heap ⇒ addr set" where
"new_addrs h as h' = as ∪ {a. lim h ≤ a ∧ a < lim h'}"
lemma new_addr_refl[simp]: "new_addrs h as h = as"
unfolding new_addrs_def by auto
text ‹
Apart from correctness of the program wrt. the pre- and post condition,
a Hoare-triple also encodes some well-formedness conditions of the command:
The command must not change addresses outside the address range of the
precondition, and it must not decrease the heap limit.
Note that we do not require that the command only reads from heap locations
inside the precondition's address range, as this condition would be quite
complicated to express with the heap model of Imperative/HOL, and is not
necessary in our formalization of partial heaps, that always contain the
information for all addresses.
›
definition hoare_triple
:: "assn ⇒ 'a Heap ⇒ ('a ⇒ assn) ⇒ bool" ("<_>/ _/ <_>")
where
"<P> c <Q> ≡ ∀h as. (h,as)⊨P ⟶ (∃r h' t. execute c h = Some (r,h',t)
∧ (let as'=new_addrs h as h' in
(h',as')⊨Q r ∧ relH ({a . a<lim h ∧ a∉as}) h h'
∧ lim h ≤ lim h'))"
text ‹Sanity checking theorems for Hoare-Triples›
lemma
assumes "<P> c <Q>"
assumes "(h,as)⊨P"
shows hoare_triple_success: "success c h"
and hoare_triple_effect: "∃h' r t. effect c h h' r t ∧ (h',new_addrs h as h')⊨Q r"
using assms
unfolding hoare_triple_def success_def effect_def
apply -
apply (auto simp: Let_def) apply fastforce+ done
lemma hoare_tripleE:
assumes "<P> c <Q>"
assumes "(h,as)⊨P"
obtains r h' t where
"execute c h = Some (r,h',t)"
"(h',new_addrs h as h')⊨Q r"
"relH ({a . a<lim h ∧ a∉as}) h h'"
"lim h ≤ lim h'"
using assms
unfolding hoare_triple_def Let_def
by blast
lemma hoare_tripleI[intro?]:
assumes "⋀h as. (h,as)⊨P ⟹ (∃r h' t.
execute c h = Some (r,h',t)
∧ (h',new_addrs h as h') ⊨ Q r
∧ relH ({a . a<lim h ∧ a∉as}) h h'
∧ lim h ≤ lim h'
)"
shows "<P> c <Q>"
using assms unfolding hoare_triple_def Let_def
by blast
text ‹For garbage-collected languages, specifications usually allow for some
arbitrary heap parts in the postcondition. The following abbreviation defines
a handy shortcut notation for such specifications.›
abbreviation hoare_triple'
:: "assn ⇒ 'r Heap ⇒ ('r ⇒ assn) ⇒ bool" ("<_> _ <_>⇩t")
where "<P> c <Q>⇩t ≡ <P> c <λr. Q r * true>"
subsection ‹Rules›
text ‹
In this section, we provide a set of rules to prove Hoare-Triples correct.
›
subsubsection ‹Basic Rules›
lemma hoare_triple_preI:
assumes "⋀h. h⊨P ⟹ <P> c <Q>"
shows "<P> c <Q>"
using assms
unfolding hoare_triple_def
by auto
lemma frame_rule:
assumes A: "<P> c <Q>"
shows "<P*R> c <λx. Q x * R>"
unfolding hoare_triple_def Let_def
apply (intro allI impI)
proof -
fix h as
assume "(h,as) ⊨ P * R"
then obtain as1 as2 where [simp]: "as=as1∪as2" and DJ: "as1∩as2={}"
and M1: "(h,as1)⊨P" and M2: "(h,as2)⊨R"
by (auto simp: mod_star_conv)
from hoare_tripleE[OF A M1] obtain r h' t where
EX: "execute c h = Some (r, h',t)"
and MDL: "(h', new_addrs h as1 h') ⊨ Q r"
and RH1: "relH {a. a < lim h ∧ a ∉ as1} h h'"
and "lim h ≤ lim h'"
.
have "{a. a < lim h ∧ a ∉ as} ⊆ {a. a < lim h ∧ a ∉ as1}"
by auto
then have "relH {a. a < lim h ∧ a ∉ as} h h'" using RH1
by (blast intro: relH_subset)
have DJN: "new_addrs h as1 h' ∩ as2 = {}"
using DJ models_in_range[OF M2]
by (auto simp: in_range.simps new_addrs_def)
moreover have "as2 ⊆ {a. a < lim h ∧ a ∉ as1}"
using DJ models_in_range[OF M2]
by (auto simp: in_range.simps)
hence "relH as2 h h'" using RH1
by (blast intro: relH_subset)
with M2 have "(h', as2)⊨R"
by (metis mem_Collect_eq Rep_assn
proper_iff relH_in_rangeI(2))
moreover have "new_addrs h as h'
= new_addrs h as1 h' ∪ as2"
by (auto simp: new_addrs_def)
ultimately have
M: "(h', new_addrs h as h') ⊨ Q r * R"
using MDL
unfolding times_assn_def
apply (simp add: Abs_assn_inverse)
apply blast
done
show "∃r h' t.
execute c h = Some (r, h',t) ∧
(h', new_addrs h as h') ⊨ Q r * R ∧ relH {a. a < lim h ∧ a ∉ as} h h' ∧ lim h ≤ lim h'"
apply (rule exI[where x=r])
apply (rule exI[where x=h'])
apply (rule exI[where x=t])
apply safe
apply fact
apply fact
apply fact
apply fact
done
qed
lemma false_rule[simp, intro!]: "<false> c <Q>"
unfolding hoare_triple_def by simp
lemma cons_rule:
assumes CPRE: "P ⟹⇩A P'"
assumes CPOST: "⋀x. Q x ⟹⇩A Q' x"
assumes R: "<P'> c <Q>"
shows "<P> c <Q'>"
using assms
unfolding hoare_triple_def Let_def
using entailsD by blast
lemmas cons_pre_rule = cons_rule[OF _ ent_refl]
lemmas cons_post_rule = cons_rule[OF ent_refl, rotated]
lemma cons_rulet: "⟦P⟹⇩tP'; ⋀x. Q x ⟹⇩t Q' x; <P'> c <Q>⇩t ⟧ ⟹ <P> c <Q'>⇩t"
unfolding entailst_def
apply (rule cons_pre_rule)
apply assumption
apply (rule cons_post_rule)
apply (erule frame_rule)
by (simp add: enttD enttI)
lemmas cons_pre_rulet = cons_rulet[OF _ entt_refl]
lemmas cons_post_rulet = cons_rulet[OF entt_refl, rotated]
lemma norm_pre_ex_rule:
assumes A: "⋀x. <P x> f <Q>"
shows "<∃⇩Ax. P x> f <Q>"
unfolding hoare_triple_def Let_def
apply (intro allI impI, elim conjE mod_exE)
using assms hoare_tripleE by fastforce
lemma norm_pre_pure_iff[simp]:
"<P*↑b> f <Q> ⟷ (b ⟶ <P> f <Q>)"
unfolding hoare_triple_def Let_def
by auto
lemma norm_pre_pure_iff_sng[simp]:
"<↑b> f <Q> ⟷ (b ⟶ <emp> f <Q>)"
using norm_pre_pure_iff[where P=emp]
by simp
lemma norm_pre_pure_rule1:
"⟦b ⟹ <P> f <Q>⟧ ⟹ <P*↑b> f <Q>" by simp
lemma norm_pre_pure_rule2:
"⟦ b ⟹ <emp> f <Q> ⟧ ⟹ <↑b> f <Q>" by simp
lemmas norm_pre_pure_rule = norm_pre_pure_rule1 norm_pre_pure_rule2
lemma post_exI_rule: "<P> c <λr. Q r x> ⟹ <P> c <λr. ∃⇩Ax. Q r x>"
by (blast intro: cons_post_rule ent_ex_postI ent_refl)
subsubsection ‹Rules for Time Commands›
lemma wait_rule: "<emp> wait n <λ_. emp>"
apply rule
apply (simp add: execute_simps)
by (simp add: in_range.simps relH_refl)
lemma wait_bind_decon: "<P> m <Q> ⟹ <P> do {wait n; m} <Q>"
apply rule
apply (auto elim!: hoare_tripleE simp: execute_simps)
done
subsubsection ‹Rules for Atomic Commands›
lemma ref_rule:
"<emp> ref x <λr. r ↦⇩r x>"
unfolding one_assn_def sngr_assn_def hoare_triple_def
apply (simp add: Let_def Abs_assn_inverse)
apply (simp add: execute_simps)
apply (auto
simp: new_addrs_def Ref_Time.alloc_def Let_def
Ref_Time.set_def Ref_Time.get_def relH_def in_range.simps)
done
lemma lookup_rule:
"<p ↦⇩r x> !p <λr. p ↦⇩r x * ↑(r = x)>"
unfolding hoare_triple_def sngr_assn_def
apply (simp add: Let_def Abs_assn_inverse)
apply (simp add: execute_simps)
apply (auto elim: simp add: relH_refl in_range.simps new_addrs_def)
done
lemma update_rule:
"<p ↦⇩r y> p := x <λr. p ↦⇩r x>"
unfolding hoare_triple_def sngr_assn_def
apply (simp add: execute_simps)
apply (auto elim!:
simp: Let_def Abs_assn_inverse new_addrs_def in_range.simps
intro!: relH_set_ref)
done
lemma update_wp_rule:
"<r ↦⇩r y * ((r ↦⇩r x) -* (Q ()))> r := x <Q>"
apply (rule cons_post_rule)
apply (rule frame_rule[OF update_rule[where p=r and x=x],
where R="((r ↦⇩r x) -* (Q ()))"])
apply (rule ent_trans)
apply (rule ent_mp)
by simp
lemma new_rule:
"<emp> Array_Time.new n x <λr. r ↦⇩a replicate n x>"
unfolding hoare_triple_def snga_assn_def one_assn_def
apply (simp add: Let_def Abs_assn_inverse)
apply (simp add: execute_simps)
apply (auto
simp: Let_def new_addrs_def Array_Time.get_def Array_Time.set_def Array_Time.alloc_def
relH_def in_range.simps
)
done
lemma make_rule: "<emp> Array_Time.make n f <λr. r ↦⇩a (map f [0 ..< n])>"
unfolding hoare_triple_def snga_assn_def one_assn_def
apply (simp add: Let_def Abs_assn_inverse)
apply (simp add: execute_simps)
apply (auto
simp: Let_def new_addrs_def Array_Time.get_def Array_Time.set_def Array_Time.alloc_def
relH_def in_range.simps
)
done
lemma of_list_rule: "<emp> Array_Time.of_list xs <λr. r ↦⇩a xs>"
unfolding hoare_triple_def snga_assn_def one_assn_def
apply (simp add: Let_def Abs_assn_inverse)
apply (simp add: execute_simps)
apply (auto
simp: Let_def new_addrs_def Array_Time.get_def Array_Time.set_def Array_Time.alloc_def
relH_def in_range.simps
)
by (simp add: map_idI)
lemma length_rule:
"<a ↦⇩a xs> Array_Time.len a <λr. a ↦⇩a xs * ↑(r = length xs)>"
unfolding hoare_triple_def snga_assn_def
apply (simp add: Let_def Abs_assn_inverse)
apply (simp add: execute_simps)
apply (auto
simp: Let_def new_addrs_def Array_Time.get_def Array_Time.set_def Array_Time.alloc_def
relH_def in_range.simps Array_Time.length_def
)
done
text ‹Note that the Boolean expression is placed at meta level and not
inside the precondition. This makes frame inference simpler.›
lemma nth_rule:
"⟦i < length xs⟧ ⟹ <a ↦⇩a xs> Array_Time.nth a i <λr. a ↦⇩a xs * ↑(r = xs ! i)>"
unfolding hoare_triple_def snga_assn_def
apply (simp add: Let_def Abs_assn_inverse)
apply (auto
simp: Let_def new_addrs_def Array_Time.get_def Array_Time.set_def Array_Time.alloc_def
relH_def in_range.simps Array_Time.length_def
execute_simps
)
done
lemma upd_rule:
"⟦i < length xs⟧ ⟹
<a ↦⇩a xs>
Array_Time.upd i x a
<λr. (a ↦⇩a (list_update xs i x)) * ↑(r = a)>"
unfolding hoare_triple_def snga_assn_def
apply (simp add: Let_def Abs_assn_inverse)
apply (auto
simp: Let_def new_addrs_def Array_Time.get_def Array_Time.set_def Array_Time.alloc_def
relH_def in_range.simps Array_Time.length_def Array_Time.update_def comp_def
execute_simps
)
done
lemma freeze_rule:
"<a ↦⇩a xs> Array_Time.freeze a <λr. a ↦⇩a xs * ↑(r = xs)>"
unfolding hoare_triple_def snga_assn_def
apply (simp add: Let_def Abs_assn_inverse)
apply (auto
simp: Let_def new_addrs_def Array_Time.get_def Array_Time.set_def Array_Time.alloc_def
relH_def in_range.simps Array_Time.length_def Array_Time.update_def
execute_simps
)
done
lemma return_wp_rule:
"<Q x> return x <Q>"
unfolding hoare_triple_def Let_def
apply (auto simp: execute_simps)
apply (rule relH_refl)
apply (simp add: in_range.simps)
done
lemma return_sp_rule:
"<P> return x <λr. P * ↑(r = x)>"
unfolding hoare_triple_def Let_def
apply (simp add: Abs_assn_inverse)
apply (auto intro!: relH_refl intro: models_in_range simp: execute_simps)
apply (simp add: in_range.simps)
done
lemma raise_iff:
"<P> raise s <Q> ⟷ P = false"
unfolding hoare_triple_def Let_def
apply (rule iffI)
apply (unfold bot_assn_def) []
apply rule
apply (auto simp add: execute_simps) []
apply (auto simp add: execute_simps) []
done
lemma raise_rule: "<false> raise s <Q>"
by (simp add: raise_iff)
subsubsection ‹Rules for Composed Commands›
lemma bind_rule:
assumes T1: "<P> f <R>"
assumes T2: "⋀x. <R x> g x <Q>"
shows "<P> bind f g <Q>"
proof
fix h as
assume "(h, as) ⊨ P"
from hoare_tripleE[OF T1 this] obtain rf h' t' where
EX_F: "execute f h = Some (rf, h',t')"
and POST_F: "(h', new_addrs h as h') ⊨ R rf"
and RH_F: "relH {a. a < lim h ∧ a ∉ as} h h'"
and LIM_F: "lim h ≤ lim h'"
.
from hoare_tripleE[OF T2 POST_F] obtain rg h'' t'' where
EX_G: "execute (g rf) h' = Some (rg, h'',t'')"
and POST_G: "(h'', new_addrs h' (new_addrs h as h') h'') ⊨ Q rg"
and RH_G: "relH {a. a < lim h' ∧ a ∉ new_addrs h as h'} h' h''"
and LIM_G: "lim h' ≤ lim h''"
.
have
"new_addrs
h'
(new_addrs h as h')
h''
= new_addrs h as h''"
using LIM_F LIM_G
by (auto simp add: new_addrs_def)
with POST_G have
"(h'', new_addrs h as h'') ⊨ Q rg"
by simp
note RH_F
also have "relH {a. a < lim h ∧ a ∉ as} h' h''"
apply (rule relH_subset[OF RH_G])
using LIM_F LIM_G
by (auto simp: new_addrs_def)
finally have "relH {a. a < lim h ∧ a ∉ as} h h''" .
note LIM_F
also note LIM_G
finally have "lim h ≤ lim h''" .
show "∃r h' t'.
execute (f ⤜ g) h = Some (r, h',t') ∧
(h', new_addrs h as h') ⊨ Q r ∧ relH {a. a < lim h ∧ a ∉ as} h h' ∧ lim h ≤ lim h'"
apply (intro exI conjI)
apply (simp add: EX_F EX_G execute_simps; fail)
apply fact+
done
qed
lemma bind_rule' :
assumes T1: "⋀ r. <P> f <λ r. (P * R r) >"
assumes T2: "⋀x. <R x * P> g x <Q>"
shows "<P> bind f g <Q>"
by (metis (no_types, lifting) T1 T2 ab_semigroup_mult_class.mult.commute bind_rule)
lemma if_rule:
assumes "b ⟹ <P> f <Q>"
assumes "¬b ⟹ <P> g <Q>"
shows "<P> if b then f else g <Q>"
using assms by auto
lemma if_rule_split:
assumes B: "b ⟹ <P> f <Q1>"
assumes NB: "¬b ⟹ <P> g <Q2>"
assumes M: "⋀x. (Q1 x * ↑b) ∨⇩A (Q2 x * ↑(¬b)) ⟹⇩A Q x"
shows "<P> if b then f else g <Q>"
apply (cases b)
apply simp_all
apply (rule cons_post_rule)
apply (erule B)
apply (rule ent_trans[OF _ ent_disjI1[OF M]])
apply simp
apply (rule cons_post_rule)
apply (erule NB)
apply (rule ent_trans[OF _ ent_disjI2[OF M]])
apply simp
done
lemma split_rule:
assumes P: "<P> c <R>"
assumes Q: "<Q> c <R>"
shows "<P ∨⇩A Q> c <R>"
apply rule
using assms
apply (auto elim!: hoare_tripleE)
done
lemmas decon_if_split = if_rule_split split_rule
lemma case_prod_rule:
"(⋀a b. x = (a, b) ⟹ <P> f a b <Q>) ⟹ <P> case x of (a, b) ⇒ f a b <Q>"
by (auto split: prod.split)
lemma case_list_rule:
"⟦ l=[] ⟹ <P> fn <Q>; ⋀x xs. l=x#xs ⟹ <P> fc x xs <Q> ⟧ ⟹
<P> case_list fn fc l <Q>"
by (auto split: list.split)
lemma case_option_rule:
"⟦ v=None ⟹ <P> fn <Q>; ⋀x. v=Some x ⟹ <P> fs x <Q> ⟧
⟹ <P> case_option fn fs v <Q>"
by (auto split: option.split)
lemma case_sum_rule:
"⟦ ⋀x. v=Inl x ⟹ <P> fl x <Q>;
⋀x. v=Inr x ⟹ <P> fr x <Q> ⟧
⟹ <P> case_sum fl fr v <Q>"
by (auto split: sum.split)
lemma let_rule: "(⋀x. x = t ⟹ <P> f x <Q>) ⟹ <P> Let t f <Q>"
by (auto)
end
Theory Refine_Imp_Hol
section ‹Refinement for Imperative-HOL Programs›
theory Refine_Imp_Hol
imports "Hoare_Triple"
"HOL-Eisbach.Eisbach"
begin
subsection ‹Assertions›
text ‹We add assertions that consume no time to Imperative HOL Time.
Note that the original \<^const>‹assert› consumes one time unit, i.e., is designed for
actually being checked at runtime. On the other hand, our assertions are not executable,
and must be refined before code generation.
›
definition [code del]: "assert' P ≡ if P then ureturn () else raise ''assert''"
lemma execute_assert'[execute_simps]: "execute (assert' P) h = (if P then Some ((),h,0) else None)"
by (auto simp: assert'_def execute_simps)
lemma assert'_rule: "⟦⋀h. h⊨P ⟹ φ⟧ ⟹ <P> assert' φ <λ_. P>"
apply rule
apply (auto simp: execute_simps in_range.simps relH_refl)
done
lemma assert'_bind_rule:
assumes "⋀h. h⊨P ⟹ φ"
assumes "φ ⟹ <P> c <Q>"
shows "<P> do {assert' φ; c} <Q>"
apply rule
using assms
apply (auto simp: execute_simps in_range.simps relH_refl elim!: hoare_tripleE)
done
subsection ‹Refinement Predicate›
text ‹An imperative-HOL program ‹p› refines a program ‹q›, if either ‹q› fails, or ‹p› returns the
same result as ‹q›. In case ‹q› is already proved correct (in particular does not fail), this
implies correctness of ‹p›. Moreover, for the refinement proof, we can assume that ‹q› does not fail,
in particular, that all assertions in ‹q› hold. This can be used to transfer knowledge from the
correctness proof (proving the assertions) to the refinement proof (assuming the assertions).
›
definition "refines p q ≡ ∀h. case execute q h of None ⇒ True | Some (r,h',t) ⇒ execute p h = Some (r,h',t)"
lemma hoare_triple_refines:
assumes "<P> c <Q>"
assumes "refines c' c"
shows "<P> c' <Q>"
apply rule
using assms
by (auto simp: refines_def elim!: hoare_tripleE split: option.splits)
subsubsection ‹Admissibility›
context begin
private lemma refines_adm_aux: "option.admissible (λxa. ∀h a aa b. xa h = Some (a, aa, b) ⟶ execute (t x) h = Some (a, aa, b))"
proof-
have "option.admissible (λxa. ∀h y. xa h = Some y ⟶ execute (t x) h = Some y)"
using option_admissible by metis
thus ?thesis by auto
qed
lemma refines_adm: "heap.admissible (λf. ∀x. refines (t x) (f x) )"
unfolding refines_def
apply (rule admissible_fun[OF heap_interpretation])
unfolding Heap_lub_def Heap_ord_def
apply (rule admissible_image)
using option.partial_function_definitions_axioms partial_function_lift apply auto[1]
apply(simp split: option.splits)
apply auto[3]
subgoal for x
apply (simp add: comp_def)
apply(rule refines_adm_aux)
done
subgoal for xa y
apply (metis Heap_execute)
done
done
end
subsection ‹Syntactic rules for \<^const>‹refines››
named_theorems refines_rule
lemma refines_assert'[refines_rule]: "refines (ureturn ()) (assert' φ)"
unfolding refines_def
by (simp add: execute_simps)
lemma refines_assert'_bind[refines_rule]: "refines p q ⟹ refines p (do {assert' φ; q})"
unfolding refines_def
apply (cases φ)
apply (auto simp add: execute_simps split: option.splits)
done
lemma refines_bind[refines_rule]: "refines m m' ⟹ (⋀x. refines (f x) (f' x)) ⟹ refines (do {x←m; f x}) (do {x←m'; f' x})"
unfolding refines_def
apply clarsimp
subgoal for h
apply (cases "execute m' h"; cases "execute m h")
apply (auto simp add: execute_simps split: option.splits)
by (smt (verit, best) option.case(2) prod.simps(2) timeFrame.elims)
done
lemma refines_If[refines_rule]: "⟦b⟹refines t t'⟧ ⟹ ⟦¬b⟹refines e e'⟧ ⟹ refines (If b t e) (If b t' e')" by auto
lemma refines_Let[refines_rule]: "⟦ ⋀x. ⟦x=v⟧ ⟹ refines (f x) (f' x) ⟧ ⟹ refines (let x=v in f x) (let x=v in f' x)" by auto
lemma refines_refl: "refines p p"
unfolding refines_def
by (auto split: option.splits)
lemma refines_empty[simp]: "refines m (Heap.Heap Map.empty)"
apply(simp add: refines_def)
done
lemma refines_let_right: assumes "refines m (m' a)"
shows "refines m (let x = a in m' x)"
using assms by simp
lemma refines_case_prod_right: assumes "⋀ a b. refines m (m' a b)"
shows "refines m (case t of (a,b) ⇒ m' a b)"
using assms apply(cases t)
by simp
lemma refines_option[refines_rule]: assumes "a=a'" "refines m1 m1'" "⋀ x. refines (m2 x) (m2' x)"
shows "refines (case a of None ⇒ m1 | Some x ⇒ m2 x) (case a' of None ⇒ m1' | Some x ⇒ m2' x)"
using assms apply(cases a')
apply simp_all
done
lemma prod_case_refines[refines_rule]: assumes "p= p'" " ⋀ a b. refines (f a b) (f' a b)"
shows " refines (case p of (a, b) ⇒ f a b) (case p' of (a, b) ⇒ f' a b )"
using assms apply(cases p') by simp
subsection ‹Automation›
method refines_step= determ‹rule refines_rule refl refines_refl refines_let_right refines_case_prod_right
| assumption | simp only:›
method refines = refines_step+
end
Theory Automation
section ‹Automation›
theory Automation
imports Hoare_Triple Refine_Imp_Hol
begin
text ‹
In this theory, we provide a set of tactics and a simplifier setup for easy
reasoning with our separation logic.›
subsection ‹Normalization of Assertions›
text ‹
In this section, we provide a set of lemmas and a simplifier
setup to bring assertions to a normal form. We provide a simproc that
detects pure parts of assertions and duplicate pointers. Moreover,
we provide ac-rules for assertions. See Section~\ref{sec:auto:overview}
for a short overview of the available proof methods.
›
lemmas assn_aci =
inf_aci[where 'a=assn]
sup_aci[where 'a=assn]
mult.left_ac[where 'a=assn]
lemmas star_assoc = mult.assoc[where 'a=assn]
lemmas assn_assoc =
mult.left_assoc inf_assoc[where 'a=assn] sup_assoc[where 'a=assn]
lemma merge_true_star_ctx: "true * (true * P) = true * P"
by (simp add: mult.left_ac)
lemmas star_aci =
mult.assoc[where 'a=assn] mult.commute[where 'a=assn] mult.left_commute[where 'a=assn]
assn_one_left mult_1_right[where 'a=assn]
merge_true_star merge_true_star_ctx
text ‹Move existential quantifiers to the front of assertions›
lemma ex_assn_move_out[simp]:
"⋀Q R. (∃⇩Ax. Q x) * R = (∃⇩Ax. (Q x * R))"
"⋀Q R. R * (∃⇩Ax. Q x) = (∃⇩Ax. (R * Q x))"
"⋀P Q. (∃⇩Ax. Q x) ∧⇩A P = (∃⇩Ax. (Q x ∧⇩A P)) "
"⋀P Q. Q ∧⇩A (∃⇩Ax. P x) = (∃⇩Ax. (Q ∧⇩A P x))"
"⋀P Q. (∃⇩Ax. Q x) ∨⇩A P = (∃⇩Ax. (Q x ∨⇩A P))"
"⋀P Q. Q ∨⇩A (∃⇩Ax. P x) = (∃⇩Ax. (Q ∨⇩A P x))"
apply -
apply (simp add: ex_distrib_star)
apply (subst mult.commute)
apply (subst (2) mult.commute)
apply (simp add: ex_distrib_star)
apply (simp add: ex_distrib_and)
apply (subst inf_commute)
apply (subst (2) inf_commute)
apply (simp add: ex_distrib_and)
apply (simp add: ex_distrib_or)
apply (subst sup_commute)
apply (subst (2) sup_commute)
apply (simp add: ex_distrib_or)
done
text ‹Extract pure assertions from and-clauses›
lemma and_extract_pure_left_iff[simp]: "↑b ∧⇩A Q = (emp∧⇩AQ)*↑b"
by (cases b) auto
lemma and_extract_pure_left_ctx_iff[simp]: "P*↑b ∧⇩A Q = (P∧⇩AQ)*↑b"
by (cases b) auto
lemma and_extract_pure_right_iff[simp]: "P ∧⇩A ↑b = (emp∧⇩AP)*↑b"
by (cases b) (auto simp: assn_aci)
lemma and_extract_pure_right_ctx_iff[simp]: "P ∧⇩A Q*↑b = (P∧⇩AQ)*↑b"
by (cases b) auto
lemmas and_extract_pure_iff =
and_extract_pure_left_iff and_extract_pure_left_ctx_iff
and_extract_pure_right_iff and_extract_pure_right_ctx_iff
lemmas norm_assertion_simps =
mult_1[where 'a=assn] mult_1_right[where 'a=assn]
inf_top_left[where 'a=assn] inf_top_right[where 'a=assn]
sup_bot_left[where 'a=assn] sup_bot_right[where 'a=assn]
star_false_left star_false_right
inf_bot_left[where 'a=assn] inf_bot_right[where 'a=assn]
sup_top_left[where 'a=assn] sup_top_right[where 'a=assn]
mult.left_assoc[where 'a=assn]
inf_assoc[where 'a=assn]
sup_assoc[where 'a=assn]
ex_assn_move_out ex_assn_const
and_extract_pure_iff
merge_pure_star merge_pure_and merge_pure_or
merge_true_star
inf_idem[where 'a=assn] sup_idem[where 'a=assn]
sngr_same_false snga_same_false
subsubsection ‹Simplifier Setup Fine-Tuning›
text ‹However, it is safest to disable this rewriting, as there is
a working standard simplifier setup for ‹(≠)›
›
subsection ‹Normalization of Entailments›
text ‹Used by existential quantifier extraction tactic›
lemma enorm_exI':
"(⋀x. Z x ⟶ (P ⟹⇩A Q x)) ⟹ (∃x. Z x) ⟶ (P ⟹⇩A (∃⇩Ax. Q x))"
by (metis ent_ex_postI)
text ‹Example of how to build an extraction lemma.›
thm enorm_exI'[OF enorm_exI'[OF imp_refl]]
lemmas ent_triv = ent_true ent_false
text ‹Dummy rule to detect Hoare triple goal›
lemma is_hoare_triple: "<P> c <Q> ⟹ <P> c <Q>" .
text ‹Dummy rule to detect entailment goal›
lemma is_entails: "P⟹⇩AQ ⟹ P ⟹⇩AQ" .
subsection ‹Frame Matcher›
text ‹Given star-lists P,Q and a frame F, this method tries to match
all elements of Q with corresponding elements of P. The result is a
partial match, that contains matching pairs and the unmatched content.›
text ‹The frame-matcher internally uses syntactic lists separated by
star, and delimited by the special symbol ‹SLN›, which is defined
to be ‹emp›.›
definition [simp]: "SLN ≡ emp"
lemma SLN_left: "SLN * P = P" by simp
lemma SLN_right: "P * SLN = P" by simp
lemmas SLN_normalize = SLN_right mult.left_assoc[where 'a=assn]
lemmas SLN_strip = SLN_right SLN_left mult.left_assoc[where 'a=assn]
text ‹A query to the frame matcher. Contains the assertions
P and Q that shall be matched, as well as a frame F, that is not
touched.›
definition [simp]: "FI_QUERY P Q F ≡ P ⟹⇩A Q*F"
abbreviation "fi_m_fst M ≡ foldr (*) (map fst M) emp"
abbreviation "fi_m_snd M ≡ foldr (*) (map snd M) emp"
abbreviation "fi_m_match M ≡ (∀(p,q)∈set M. p ⟹⇩A q)"
text ‹A result of the frame matcher. Contains a list of matching pairs,
as well as the unmatched parts of P and Q, and the frame F.
›
definition [simp]: "FI_RESULT M UP UQ F ≡
fi_m_match M ⟶ (fi_m_fst M * UP ⟹⇩A fi_m_snd M * UQ * F)"
text ‹Internal structure used by the frame matcher:
m contains the matched pairs; p,q the assertions that still needs to be
matched; up,uq the assertions that could not be matched; and f the frame.
p and q are SLN-delimited syntactic lists.
›
definition [simp]: "FI m p q up uq f ≡
fi_m_match m ⟶ (fi_m_fst m * p * up ⟹⇩A fi_m_snd m * q * uq * f)"
text ‹Initialize processing of query›
lemma FI_init:
assumes "FI [] (SLN*P) (SLN*Q) SLN SLN F"
shows "FI_QUERY P Q F"
using assms by simp
text ‹Construct result from internal representation›
lemma FI_finalize:
assumes "FI_RESULT m (p*up) (q*uq) f"
shows "FI m p q up uq f"
using assms by (simp add: assn_aci)
text ‹Auxiliary lemma to show that all matching pairs together form
an entailment. This is required for most applications.›
lemma fi_match_entails:
assumes "fi_m_match m"
shows "fi_m_fst m ⟹⇩A fi_m_snd m"
using assms apply (induct m)
apply (simp_all split: prod.split_asm add: ent_star_mono)
done
text ‹Internally, the frame matcher tries to match the first assertion
of q with the first assertion of p. If no match is found, the first
assertion of p is discarded. If no match for any assertion in p can be
found, the first assertion of q is discarded.›
text ‹Match›
lemma FI_match:
assumes "p ⟹⇩A q"
assumes "FI ((p,q)#m) (ps*up) (qs*uq) SLN SLN f"
shows "FI m (ps*p) (qs*q) up uq f"
using assms unfolding FI_def
by (simp add: assn_aci)
text ‹No match›
lemma FI_p_nomatch:
assumes "FI m ps (qs*q) (p*up) uq f"
shows "FI m (ps*p) (qs*q) up uq f"
using assms unfolding FI_def
by (simp add: assn_aci)
text ‹Head of q could not be matched›
lemma FI_q_nomatch:
assumes "FI m (SLN*up) qs SLN (q*uq) f"
shows "FI m SLN (qs*q) up uq f"
using assms unfolding FI_def
by (simp add: assn_aci)
subsection ‹Frame Inference›
lemma frame_inference_init:
assumes "FI_QUERY P Q F"
shows "P ⟹⇩A Q * F"
using assms by simp
lemma frame_inference_finalize:
shows "FI_RESULT M F emp F"
apply simp
apply rule
apply (drule fi_match_entails)
apply (rule ent_star_mono[OF _ ent_refl])
apply assumption
done
subsection ‹Entailment Solver›
lemma entails_solve_init:
"FI_QUERY P Q true ⟹ P ⟹⇩A Q * true"
"FI_QUERY P Q emp ⟹ P ⟹⇩A Q"
by (simp_all add: assn_aci)
lemma entails_solve_finalize:
"FI_RESULT M P emp true"
"FI_RESULT M emp emp emp"
by (auto simp add: fi_match_entails intro: ent_star_mono)
lemmas solve_ent_preprocess_simps =
ent_pure_post_iff ent_pure_post_iff_sng ent_pure_pre_iff ent_pure_pre_iff_sng
subsection ‹Verification Condition Generator›
lemmas normalize_rules = norm_pre_ex_rule norm_pre_pure_rule
text ‹May be useful in simple, manual proofs, where the postcondition
is no schematic variable.›
lemmas return_cons_rule = cons_pre_rule[OF _ return_wp_rule]
text ‹Useful frame-rule variant for manual proof:›
lemma frame_rule_left:
"<P> c <Q> ⟹ <R * P> c <λx. R * Q x>"
using frame_rule by (simp add: assn_aci)
lemmas deconstruct_rules =
wait_bind_decon assert'_bind_rule
bind_rule if_rule false_rule return_sp_rule let_rule
case_prod_rule case_list_rule case_option_rule case_sum_rule
lemmas heap_rules =
ref_rule
lookup_rule
update_rule
new_rule
make_rule
of_list_rule
length_rule
nth_rule
upd_rule
freeze_rule
wait_rule
assert'_rule
lemma fi_rule:
assumes CMD: "<P> c <Q>"
assumes FRAME: "Ps ⟹⇩A P * F"
shows "<Ps> c <λx. Q x * F>"
apply (rule cons_pre_rule[rotated])
apply (rule frame_rule)
apply (rule CMD)
apply (rule FRAME)
done
subsection ‹ML-setup›
named_theorems sep_dflt_simps "Seplogic: Default simplification rules for automated solvers"
named_theorems sep_eintros "Seplogic: Intro rules for entailment solver"
named_theorems sep_heap_rules "Seplogic: VCG heap rules"
named_theorems sep_decon_rules "Seplogic: VCG deconstruct rules"
ML ‹
infix 1 THEN_IGNORE_NEWGOALS
structure Seplogic_Auto =
struct
fun REPEAT_DETERM' tac i st = let
val n = Thm.nprems_of st
in
REPEAT_DETERM (COND (has_fewer_prems n) no_tac (tac i)) st
end
fun tr_term t = Pretty.string_of (Syntax.pretty_term @{context} t);
fun (tac1 THEN_IGNORE_NEWGOALS tac2) i st = let
val np = Thm.nprems_of st
in
(tac1 i THEN (fn st' => let val np' = Thm.nprems_of st' in
if np'<np then tac2 i st'
else tac2 (i+(np'-np)+1) st'
end)) st
end;
fun find_similar (key_of:term -> term) (ts:term list) = let
fun frec _ [] = NONE
| frec tab (t::ts) = let val k=key_of t in
if Termtab.defined tab k then
SOME (the (Termtab.lookup tab k),t)
else frec (Termtab.update (k,t) tab) ts
end
in
frec Termtab.empty ts
end;
fun dfs_opr opN (tr:'state -> term -> ('state*term option))
d (t as ((op_t as Const (fN,_))$t1$t2)) =
if fN = opN then let
val (d1,t1') = dfs_opr opN tr d t1;
val (d2,t2') = dfs_opr opN tr d1 t2;
in
case (t1',t2') of
(NONE,NONE) => (d2,NONE)
| (SOME t1',NONE) => (d2,SOME t1')
| (NONE,SOME t2') => (d2,SOME t2')
| (SOME t1',SOME t2') => (d2,SOME (op_t$t1'$t2'))
end
else tr d t
| dfs_opr _ tr d t = tr d t;
fun dfs_replace_atomic opN ot nt t = let
fun tr d t = if not d andalso t=ot then (true,SOME nt) else (d,SOME t);
val (success,SOME t') = dfs_opr opN tr false t;
in
if success then SOME t' else NONE
end;
fun assn_simproc_fun ctxt credex = let
val ([redex],ctxt') = Variable.import_terms true [Thm.term_of credex] ctxt;
val export = singleton (Variable.export ctxt' ctxt)
fun mk_star t1 t2 = @{term "(*)::assn ⇒ _ ⇒ _"}$t2$t1;
fun mk_star' NONE NONE = NONE
| mk_star' (SOME t1) NONE = SOME t1
| mk_star' NONE (SOME t2) = SOME t2
| mk_star' (SOME t1) (SOME t2) = SOME (mk_star t1 t2);
fun ptrs_key (_$k$_) = k;
fun remove_term pt t = case
dfs_replace_atomic @{const_name "Groups.times_class.times"} pt
@{term emp} t
of
SOME t' => t';
fun normalize t = let
fun ep_tr (has_true,ps,ptrs) t = case t of
Const (@{const_name "Assertions.pure_assn"},_)$_
=> ((has_true,t::ps,ptrs),NONE)
| Const (@{const_name "Assertions.sngr_assn"},_)$_$_
=> ((has_true,ps,t::ptrs),SOME t)
| Const (@{const_name "Assertions.snga_assn"},_)$_$_
=> ((has_true,ps,t::ptrs),SOME t)
| Const (@{const_name "Orderings.top_class.top"},_)
=> ((true,ps,ptrs),NONE)
| (inf_op as Const (@{const_name "Lattices.inf_class.inf"},_))$t1$t2
=> ((has_true,ps,ptrs),SOME (inf_op$normalize t1$normalize t2))
| _ => ((has_true,ps,ptrs),SOME t);
fun normalizer t = case dfs_opr @{const_name "Groups.times_class.times"}
ep_tr (false,[],[]) t
of
((has_true,ps,ptrs),rt) => ((has_true,rev ps,ptrs),rt);
fun normalize_core t = let
val ((has_true,pures,ptrs),rt) = normalizer t;
val similar = find_similar ptrs_key ptrs;
val true_t = if has_true then SOME @{term "Assertions.top_assn"}
else NONE;
val pures' = case pures of
[] => NONE
| p::ps => SOME (fold mk_star ps p);
in
case similar of NONE => the (mk_star' pures' (mk_star' true_t rt))
| SOME (t1,t2) => let
val t_stripped = remove_term t1 (remove_term t2 t);
in mk_star t_stripped (mk_star t1 t2) end
end;
fun skip_ex ((exq as Const (@{const_name "ex_assn"},_))$(Abs (n,ty,t))) =
exq$Abs (n,ty,skip_ex t)
| skip_ex t = normalize_core t;
val (bs,t') = strip_abs t;
val ty = fastype_of1 (map #2 bs,t');
in
if ty = @{typ assn} then
Logic.rlist_abs (bs,skip_ex t')
else t
end;
val (f,terms) = strip_comb redex;
val nterms = map (fn t => let
val t'=normalize t;
in t' end) terms;
val new_form = list_comb (f,nterms);
val res_ss = (put_simpset HOL_basic_ss ctxt addsimps @{thms star_aci});
val result = Option.map (export o mk_meta_eq) (Arith_Data.prove_conv_nohyps
[simp_tac res_ss 1] ctxt' (redex,new_form)
);
in
result
end handle exc =>
if Exn.is_interrupt exc then Exn.reraise exc
else
(tracing ("assn_simproc failed with exception\n:" ^ Runtime.exn_message exc);
NONE) ;
val assn_simproc =
Simplifier.make_simproc @{context} "assn_simproc"
{lhss =
[@{term "h ⊨ P"},
@{term "P ⟹⇩A Q"},
@{term "P ⟹⇩t Q"},
@{term "Hoare_Triple.hoare_triple P c Q"},
@{term "(P::assn) = Q"}],
proc = K assn_simproc_fun};
fun dflt_tac ctxt = asm_full_simp_tac
(put_simpset HOL_ss ctxt
addsimprocs [assn_simproc]
addsimps @{thms norm_assertion_simps}
addsimps (Named_Theorems.get ctxt @{named_theorems sep_dflt_simps})
|> fold Splitter.del_split @{thms if_split}
);
fun match_frame_tac imp_solve_tac ctxt = let
val norm_tac = simp_tac (
put_simpset HOL_basic_ss ctxt addsimps @{thms SLN_normalize});
val strip_tac =
simp_tac (put_simpset HOL_basic_ss ctxt addsimps @{thms SLN_strip}) THEN'
simp_tac (put_simpset HOL_basic_ss ctxt addsimps @{thms SLN_def});
val match_tac = resolve_tac ctxt @{thms FI_match}
THEN' SOLVED' imp_solve_tac
THEN' norm_tac;
val nomatch_tac = resolve_tac ctxt @{thms FI_p_nomatch} ORELSE'
(resolve_tac ctxt @{thms FI_q_nomatch} THEN' norm_tac);
in
resolve_tac ctxt @{thms FI_init} THEN' norm_tac
THEN' REPEAT_DETERM' (FIRST' [
CHANGED o dflt_tac ctxt,
(match_tac ORELSE' nomatch_tac)])
THEN' resolve_tac ctxt @{thms FI_finalize} THEN' strip_tac
end;
fun frame_inference_tac ctxt =
resolve_tac ctxt @{thms frame_inference_init}
THEN' match_frame_tac (resolve_tac ctxt @{thms ent_refl}) ctxt
THEN' resolve_tac ctxt @{thms frame_inference_finalize};
fun extract_ex_tac ctxt i st = let
fun count_ex (Const (@{const_name Assertions.entails},_)$_$c) =
count_ex c RS @{thm HOL.mp}
| count_ex (Const (@{const_name Assertions.ex_assn},_)$Abs (_,_,t))
= count_ex t RS @{thm enorm_exI'}
| count_ex _ = @{thm imp_refl};
val concl = Logic.concl_of_goal (Thm.prop_of st) i |> HOLogic.dest_Trueprop;
val thm = count_ex concl;
in
(TRY o REPEAT_ALL_NEW (match_tac ctxt @{thms ent_ex_preI}) THEN'
resolve_tac ctxt [thm]) i st
end;
fun solve_entails_tac ctxt = let
val preprocess_entails_tac =
dflt_tac ctxt
THEN' extract_ex_tac ctxt
THEN' simp_tac
(put_simpset HOL_ss ctxt addsimps @{thms solve_ent_preprocess_simps});
val match_entails_tac =
resolve_tac ctxt @{thms entails_solve_init}
THEN' match_frame_tac (resolve_tac ctxt @{thms ent_refl}) ctxt
THEN' resolve_tac ctxt @{thms entails_solve_finalize};
in
preprocess_entails_tac
THEN' (TRY o
REPEAT_ALL_NEW (match_tac ctxt (rev (Named_Theorems.get ctxt @{named_theorems sep_eintros}))))
THEN_ALL_NEW (dflt_tac ctxt THEN'
TRY o (match_tac ctxt @{thms ent_triv}
ORELSE' resolve_tac ctxt @{thms ent_refl}
ORELSE' match_entails_tac))
end;
fun heap_rule_tac ctxt h_thms =
resolve_tac ctxt h_thms ORELSE' (
resolve_tac ctxt @{thms fi_rule} THEN' (resolve_tac ctxt h_thms THEN_IGNORE_NEWGOALS
frame_inference_tac ctxt));
fun vcg_step_tac ctxt = let
val h_thms = rev (Named_Theorems.get ctxt @{named_theorems sep_heap_rules});
val d_thms = rev (Named_Theorems.get ctxt @{named_theorems sep_decon_rules});
val heap_rule_tac = heap_rule_tac ctxt h_thms
fun app_post_cons_tac i st =
case Logic.concl_of_goal (Thm.prop_of st) i |> HOLogic.dest_Trueprop of
Const (@{const_name Hoare_Triple.hoare_triple},_)$_$_$qt =>
if is_Var (head_of qt) then no_tac st
else resolve_tac ctxt @{thms cons_post_rule} i st
| _ => no_tac st;
in
CSUBGOAL (snd #> (FIRST' [
CHANGED o dflt_tac ctxt,
REPEAT_ALL_NEW (resolve_tac ctxt @{thms normalize_rules}),
CHANGED o (FIRST' [resolve_tac ctxt d_thms, heap_rule_tac]
ORELSE' (app_post_cons_tac THEN'
FIRST' [resolve_tac ctxt d_thms, heap_rule_tac]))
]))
end;
fun vcg_tac ctxt = REPEAT_DETERM' (vcg_step_tac ctxt)
fun sep_autosolve_tac do_pre do_post ctxt = let
val pre_tacs = [
CHANGED o clarsimp_tac ctxt,
CHANGED o REPEAT_ALL_NEW (match_tac ctxt @{thms ballI allI impI conjI})
];
val main_tacs = [
match_tac ctxt @{thms is_hoare_triple} THEN' CHANGED o vcg_tac ctxt,
match_tac ctxt @{thms is_entails} THEN' CHANGED o solve_entails_tac ctxt
];
val post_tacs = [SELECT_GOAL (auto_tac ctxt)];
val tacs = (if do_pre then pre_tacs else [])
@ main_tacs
@ (if do_post then post_tacs else []);
in
REPEAT_DETERM' (CHANGED o FIRST' tacs)
end;
val dflt_simps_modifiers = [
Args.$$$ "dflt_simps" -- Scan.option Args.add -- Args.colon
>> K (Method.modifier (Named_Theorems.add @{named_theorems sep_dflt_simps}) ⌂),
Args.$$$ "dflt_simps" -- Scan.option Args.del -- Args.colon
>> K (Method.modifier (Named_Theorems.del @{named_theorems sep_dflt_simps}) ⌂)
];
val heap_modifiers = [
Args.$$$ "heap" -- Scan.option Args.add -- Args.colon
>> K (Method.modifier (Named_Theorems.add @{named_theorems sep_heap_rules}) ⌂),
Args.$$$ "heap" -- Scan.option Args.del -- Args.colon
>> K (Method.modifier (Named_Theorems.del @{named_theorems sep_heap_rules}) ⌂)
];
val decon_modifiers = [
Args.$$$ "decon" -- Scan.option Args.add -- Args.colon
>> K (Method.modifier (Named_Theorems.add @{named_theorems sep_decon_rules}) ⌂),
Args.$$$ "decon" -- Scan.option Args.del -- Args.colon
>> K (Method.modifier (Named_Theorems.del @{named_theorems sep_decon_rules}) ⌂)
];
val eintros_modifiers = [
Args.$$$ "eintros" -- Scan.option Args.add -- Args.colon
>> K (Method.modifier (Named_Theorems.add @{named_theorems sep_eintros}) ⌂),
Args.$$$ "eintros" -- Scan.option Args.del -- Args.colon
>> K (Method.modifier (Named_Theorems.del @{named_theorems sep_eintros}) ⌂)
];
val solve_entails_modifiers = dflt_simps_modifiers @ eintros_modifiers;
val vcg_modifiers =
heap_modifiers @ decon_modifiers @ dflt_simps_modifiers;
val sep_auto_modifiers =
clasimp_modifiers @ vcg_modifiers @ eintros_modifiers;
end;
›
simproc_setup assn_simproc
("h⊨P" | "P⟹⇩AQ" | "P⟹⇩tQ" | "<P> c <R>" | "(P::assn) = Q")
= ‹K Seplogic_Auto.assn_simproc_fun›
method_setup assn_simp =‹Scan.succeed (fn ctxt => (SIMPLE_METHOD' (
CHANGED o Seplogic_Auto.dflt_tac ctxt
)))› "Seplogic: Simplification of assertions"
method_setup frame_inference = ‹Scan.succeed (fn ctxt => (SIMPLE_METHOD' (
CHANGED o Seplogic_Auto.frame_inference_tac ctxt
)))› "Seplogic: Frame inference"
method_setup solve_entails = ‹
Method.sections Seplogic_Auto.solve_entails_modifiers >>
(fn _ => fn ctxt => SIMPLE_METHOD' (
CHANGED o Seplogic_Auto.solve_entails_tac ctxt
))› "Seplogic: Entailment Solver"
method_setup heap_rule = ‹
Attrib.thms >>
(fn thms => fn ctxt => SIMPLE_METHOD' (
let
val thms = case thms of [] => rev (Named_Theorems.get ctxt @{named_theorems sep_heap_rules})
| _ => thms
in
CHANGED o Seplogic_Auto.heap_rule_tac ctxt thms
end
))› "Seplogic: Apply rule with frame inference"
method_setup vcg = ‹
Scan.lift (Args.mode "ss") --
Method.sections Seplogic_Auto.vcg_modifiers >>
(fn (ss,_) => fn ctxt => SIMPLE_METHOD' (
CHANGED o (
if ss then Seplogic_Auto.vcg_step_tac ctxt
else Seplogic_Auto.vcg_tac ctxt
)
))› "Seplogic: Verification Condition Generator"
method_setup sep_auto =
‹Scan.lift (Args.mode "nopre" -- Args.mode "nopost" -- Args.mode "plain")
--| Method.sections Seplogic_Auto.sep_auto_modifiers >>
(fn ((nopre,nopost),plain) => fn ctxt => SIMPLE_METHOD' (
CHANGED o Seplogic_Auto.sep_autosolve_tac
((not nopre) andalso (not plain))
((not nopost) andalso (not plain)) ctxt
))› "Seplogic: Automatic solver"
lemmas [sep_dflt_simps] = split
declare deconstruct_rules[sep_decon_rules]
declare heap_rules[sep_heap_rules]
lemmas [sep_eintros] = impI conjI exI
subsection ‹Semi-Automatic Reasoning›
text ‹In this section, we provide some lemmas for semi-automatic reasoning›
text ‹Forward reasoning with frame. Use ‹frame_inference›-method
to discharge second assumption.›
lemma ent_frame_fwd:
assumes R: "P ⟹⇩A R"
assumes F: "Ps ⟹⇩A P*F"
assumes I: "R*F ⟹⇩A Q"
shows "Ps ⟹⇩A Q"
using assms
by (metis ent_refl ent_star_mono ent_trans)
lemma mod_frame_fwd:
assumes M: "h⊨Ps"
assumes R: "P⟹⇩AR"
assumes F: "Ps ⟹⇩A P*F"
shows "h⊨R*F"
using assms
by (metis ent_star_mono entails_def)
text ‹Apply precision rule with frame inference.›
lemma prec_frame:
assumes PREC: "precise P"
assumes M1: "h⊨(R1 ∧⇩A R2)"
assumes F1: "R1 ⟹⇩A P x p * F1"
assumes F2: "R2 ⟹⇩A P y p * F2"
shows "x=y"
using preciseD[OF PREC] M1 F1 F2
by (metis entailsD mod_and_dist)
lemma prec_frame_expl:
assumes PREC: "∀x y. (h⊨(P x * F1) ∧⇩A (P y * F2)) ⟶ x=y"
assumes M1: "h⊨(R1 ∧⇩A R2)"
assumes F1: "R1 ⟹⇩A P x * F1"
assumes F2: "R2 ⟹⇩A P y * F2"
shows "x=y"
using assms
by (metis entailsD mod_and_dist)
text ‹Variant that is useful within induction proofs, where induction
goes over ‹x› or ‹y››
lemma prec_frame':
assumes PREC: "(h⊨(P x * F1) ∧⇩A (P y * F2)) ⟶ x=y"
assumes M1: "h⊨(R1 ∧⇩A R2)"
assumes F1: "R1 ⟹⇩A P x * F1"
assumes F2: "R2 ⟹⇩A P y * F2"
shows "x=y"
using assms
by (metis entailsD mod_and_dist)
lemma ent_wand_frameI:
assumes "(Q -* R) * F ⟹⇩A S"
assumes "P ⟹⇩A F * X"
assumes "Q*X ⟹⇩A R"
shows "P ⟹⇩A S"
using assms
by (metis ent_frame_fwd ent_wandI mult.commute)
subsubsection ‹Manual Frame Inference›
lemma ent_true_drop:
"P⟹⇩AQ*true ⟹ P*R⟹⇩AQ*true"
"P⟹⇩AQ ⟹ P⟹⇩AQ*true"
apply (metis assn_times_comm ent_star_mono ent_true merge_true_star_ctx)
apply (metis assn_one_left ent_star_mono ent_true star_aci(2))
done
lemma fr_refl: "A⟹⇩AB ⟹ A*C ⟹⇩AB*C"
by (blast intro: ent_star_mono ent_refl)
lemma fr_rot: "(A*B ⟹⇩A C) ⟹ (B*A ⟹⇩A C)"
by (simp add: assn_aci)
lemma fr_rot_rhs: "(A ⟹⇩A B*C) ⟹ (A ⟹⇩A C*B)"
by (simp add: assn_aci)
lemma ent_star_mono_true:
assumes "A ⟹⇩A A' * true"
assumes "B ⟹⇩A B' * true"
shows "A*B*true ⟹⇩A A'*B'*true"
using ent_star_mono[OF assms] apply simp
using ent_true_drop(1) by blast
lemma ent_refl_true: "A ⟹⇩A A * true"
by (simp add: ent_true_drop(2))
lemma entt_fr_refl: "F⟹⇩tF' ⟹ F*A ⟹⇩t F'*A" by (rule entt_star_mono) auto
lemma entt_fr_drop: "F⟹⇩tF' ⟹ F*A ⟹⇩t F'"
using ent_true_drop(1) enttD enttI by blast
method_setup fr_rot = ‹
let
fun rot_tac ctxt =
resolve_tac ctxt @{thms fr_rot} THEN'
simp_tac (put_simpset HOL_basic_ss ctxt
addsimps @{thms star_assoc[symmetric]})
in
Scan.lift Parse.nat >>
(fn n => fn ctxt => SIMPLE_METHOD' (
fn i => REPEAT_DETERM_N n (rot_tac ctxt i)))
end
›
method_setup fr_rot_rhs = ‹
let
fun rot_tac ctxt =
resolve_tac ctxt @{thms fr_rot_rhs} THEN'
simp_tac (put_simpset HOL_basic_ss ctxt
addsimps @{thms star_assoc[symmetric]})
in
Scan.lift Parse.nat >>
(fn n => fn ctxt => SIMPLE_METHOD' (
fn i => REPEAT_DETERM_N n (rot_tac ctxt i)))
end
›
subsection ‹Test Cases›
lemma "⋀x. A x * true * Q x ⟹⇩A true * A x * Q x"
apply simp
done
lemma "A * (true * B) ⟹⇩A true * A * B"
apply (simp)
done
lemma "h⊨true*P*true ⟷ h⊨P*true"
by simp
lemma "A * true * ↑(b ∧ c) * true * B ⟹⇩A ↑b * ↑c * true *A * B"
by simp
lemma "∃y c. ∃⇩Ax. P x * (R x * Q y) * ↑ (b ∧ c) ⟹⇩A (∃⇩Ax. ↑b * (P x * (R x * Q y) * ↑c))"
apply simp
done
lemma "A * B * (↑c * B * C * D * ↑a * true * ↑d) * (∃⇩Ax. E x * F * ↑b) * true ⟹⇩A (∃⇩Ax. ↑ (c ∧ a ∧ d ∧ b) *
true * A * B * (true * B * C * D) * (E x * F))"
apply simp
done
lemma "<P> c <λr. Q r * true * ↑(b r) * true * ↑a>
⟷ <P> c <λr. Q r * true * ↑(b r ∧ a)>"
apply simp
done
lemma "(h⊨((A*B*↑b*true*↑c*true) ∧⇩A (↑(p=q)*P*Q)))
⟷ h ⊨ A * B * true ∧⇩A P * Q ∧ b ∧ c ∧ p = q"
apply simp
done
lemma assumes "FI_RESULT [(B, B), (A, A)] C D F"
shows "FI_QUERY (A*B*C) (D*B*A) F"
apply (tactic ‹Seplogic_Auto.match_frame_tac
(resolve_tac @{context} @{thms ent_refl}) @{context} 1›)
by (rule assms)
lemma
assumes "FI_RESULT [(B,B), (A,A)] C emp F"
shows "FI_QUERY (A*B*C) (B*A) F"
apply (tactic ‹Seplogic_Auto.match_frame_tac
(resolve_tac @{context} @{thms ent_refl}) @{context} 1›)
by (rule assms)
lemma
assumes "FI_RESULT [(B, B), (A, A)] emp emp F"
shows "FI_QUERY (A*B) (B*A) F"
apply (tactic ‹Seplogic_Auto.match_frame_tac
(resolve_tac @{context} @{thms ent_refl}) @{context} 1›)
by (rule assms)
lemma
assumes "FI_RESULT [(A, A)] emp emp F"
shows "FI_QUERY (A) (A) F"
apply (tactic ‹Seplogic_Auto.match_frame_tac
(resolve_tac @{context} @{thms ent_refl}) @{context} 1›)
by (rule assms)
lemma
assumes "FI_RESULT [(A, A)] (B * C * D) emp F"
shows "FI_QUERY (B*C*D*A) (A) F"
apply (tactic ‹Seplogic_Auto.match_frame_tac
(resolve_tac @{context} @{thms ent_refl}) @{context} 1›)
by (rule assms)
schematic_goal
"P1 * P2 * P3 * P4 ⟹⇩A P3 * ?R1"
"P1 * (P2 * (P3 * P4)) ⟹⇩A P1 * ?R2"
"P4 * (P2 * (P1 * P3)) ⟹⇩A P1 * ?R2'"
"P1 * P2 * P3 * P4 ⟹⇩A P4 * ?R3"
"P1 * P2 ⟹⇩A P1 * ?R4"
"P1 * P2 ⟹⇩A P2 * ?R5"
"P1 ⟹⇩A P1 * ?R6"
"P1 * P2 ⟹⇩A emp * ?R7"
by frame_inference+
lemma "⟦A; B; C; b 17⟧ ⟹
Q 1 5 3 ⟹⇩A (∃⇩Ax y z. ∃⇩Aa. Q x y z * ↑(b a) * ↑(y=5))"
by solve_entails
thm nth_rule
lemma "<P * x↦⇩a[1,2,3]>
do { v←Array_Time.nth x 1; return v }
<λr. P * x↦⇩a[1,2,3] * ↑(r=2)>"
apply sep_auto
done
subsection ‹Quick Overview of Proof Methods›
text_raw ‹\label{sec:auto:overview}›
text ‹
In this section, we give a quick overview of the available proof methods
and options. The most versatile proof method that we provide is
‹sep_auto›. It tries to solve the first subgoal, invoking appropriate
proof methods as required. If it cannot solve the subgoal completely, it
stops at the intermediate state that it could not handle any more.
‹sep_auto› can be configured by
section-arguments for the simplifier, the classical reasoner, and all
section-arguments for the verification condition generator and
entailment solver. Moreover, it takes an optional mode argument (mode), where
valid modes are:
\begin{description}
\item[(nopre)] No preprocessing of goal. The preprocessor tries to clarify
and simplify the goal before the main method is invoked.
\item[(nopost)] No postprocessing of goal. The postprocessor tries to
solve or simplify goals left over by verification condition generation or
entailment solving.
\item[(plain)] Neither pre- nor postprocessing. Just applies vcg and
entailment solver.
\end{description}
\paragraph{Entailment Solver.} The entailment solver processes goals of the
form ‹P ⟹⇩A Q›. It is invoked by the method ‹solve_entails›.
It first tries to pull out pure parts of
‹P› and ‹Q›. This may introduce quantifiers, conjunction,
and implication into the goal, that are eliminated by resolving with rules
declared as ‹sep_eintros› (method argument: eintros[add/del]:).
Moreover, it simplifies with rules declared as ‹sep_dflt_simps›
(section argument: ‹dflt_simps[add/del]:›).
Now, ‹P› and ‹Q› should have the form ‹X⇩1*…*X⇩n›.
Then, the frame-matcher is used to match all items of ‹P› with items
of ‹Q›, and thus solve the implication. Matching is currently done
syntactically, but can instantiate schematic variables.
Note that, by default, existential introduction is declared as
‹sep_eintros›-rule. This introduces schematic variables, that can
later be matched against. However, in some cases, the matching may instantiate
the schematic variables in an undesired way. In this case, the argument
‹eintros del: exI› should be passed to the entailment solver, and
the existential quantifier should be instantiated manually.
\paragraph{Frame Inference}
The method ‹frame_inference› tries to solve a goal of the
form ‹P⟹Q*?F›, by matching ‹Q› against the parts of
‹P›, and instantiating ‹?F› accordingly.
Matching is done syntactically, possibly
instantiating schematic variables. ‹P› and ‹Q› should be
assertions separated by ‹*›. Note that frame inference does no
simplification or other kinds of normalization.
The method ‹heap_rule› applies the specified heap rules, using
frame inference if necessary. If no rules are specified, the default
heap rules are used.
\paragraph{Verification Condition Generator}
The verification condition generator processes goals of the form
‹<P>c<Q>›. It is invoked by the method ‹vcg›.
First, it tries to pull out pure parts and simplifies with
the default simplification rules. Then, it tries to resolve the goal with
deconstruct rules (attribute: ‹sep_decon_rules›,
section argument: ‹decon[add/del]:›), and if this does not succeed,
it tries
to resolve the goal with heap rules (attribute: ‹sep_heap_rules›,
section argument: ‹heap[add/del]:›), using the frame rule and
frame inference.
If resolving is not possible, it also tries to apply the consequence rule to
make the postcondition a schematic variable.
›
subsection ‹Hiding of internal stuff›
hide_const (open) FI SLN
end
Theory Sep_Main
section ‹Separation Logic Framework Entrypoint›
theory Sep_Main
imports Automation
begin
text ‹Import this theory to make available Imperative/HOL with
separation logic.›
end
Theory Imperative_HOL_Add
section ‹Additions to Imperative/HOL›
theory Imperative_HOL_Add
imports "HOL-Imperative_HOL.Imperative_HOL"
begin
text ‹This theory loads the Imperative HOL framework and provides
some additional lemmas needed for the separation logic framework.›
text ‹A stronger elimination rule for ‹ref››
lemma effect_ref[effect_elims]:
assumes "effect (ref (x::('a::heap))) h h' r"
obtains "r = fst (Ref.alloc x h)" and "h' = snd (Ref.alloc x h)"
proof -
from assms have "execute (ref x) h = Some (r, h')" by (unfold effect_def)
then have "r = fst (Ref.alloc x h)" "h' = snd (Ref.alloc x h)"
by (auto simp add: execute_simps)
then show thesis ..
qed
text ‹Some lemmas about the evaluation of the limit for modifications on
a heap›
lemma lim_Ref_alloc[simp]: "lim (snd (Ref.alloc x h)) = Suc (lim h)"
unfolding Ref.alloc_def
by (simp add: Let_def)
lemma lim_Array_alloc[simp]: "lim (snd (Array.alloc x h)) = Suc (lim h)"
unfolding Array.alloc_def Array.set_def
by (simp add: Let_def)
lemma lim_Array_set[simp]: "lim (Array.set a xs h) = lim h"
unfolding Array.set_def
by (simp add: Let_def)
thm Array.update_def
lemma lim_Array_update[simp]: "lim (Array.update a i x h) = lim h"
unfolding Array.update_def
by (simp add: Let_def)
text ‹Simplification rules for the addresses of new allocated arrays and
references›
lemma addr_of_ref_alloc[simp]:
"addr_of_ref (fst (Ref.alloc x h)) = lim h"
unfolding Ref.alloc_def
by (simp add: Let_def)
lemma addr_of_array_alloc[simp]:
"addr_of_array (fst (Array.alloc x h)) = lim h"
unfolding Array.alloc_def
by (simp add: Let_def)
end
Theory Time_Reasoning
theory Time_Reasoning
imports "../Separation_Logic_Imperative_HOL/Sep_Main"
begin
text ‹Separating correctness and time reasoning for imperative HOL.
In this theory, we provide a method to add time-reasoning to
an already proved-correct program.
The time-reasoning can exploit knowledge from the correctness proof via assertions.
›
subsection ‹Selectors›
text ‹We define selectors into the result of a state-time-monad computation›
definition "fails m h ≡ execute m h = None"
definition "the_res m h ≡ case execute m h of Some (r,_,_) ⇒ r"
definition "the_heap m h ≡ case execute m h of Some (_,h',_) ⇒ h'"
text ‹We define the time to be zero for a failing computation,
such that failing computations trivially satisfy time bounds.
Note that the computation is already proved non-failing by the correctness proof,
this allows us to assume computations do not fail for the time-bound proof.
›
definition "time c h ≡ case execute c h of None ⇒ 0 | Some (_,_,t) ⇒ t"
lemma time_refines: "refines c c' ⟹ ¬fails c' h ⟹ time c h ≤ time c' h"
unfolding time_def refines_def fails_def
apply (auto split: option.splits)
done
lemma fails_refines: "refines c c' ⟹ fails c h ⟹ fails c' h"
unfolding time_def refines_def fails_def
apply (auto split: option.splits)
by (metis option.exhaust prod_cases3)
subsubsection ‹Simplification Lemmas›
named_theorems fails_simp
named_theorems time_simp
lemma fails_return[fails_simp]: "¬fails (return x) h"
unfolding fails_def by (auto simp add: execute_simps split: option.split)
lemma fails_wait[fails_simp]: "¬fails (wait x) h"
unfolding fails_def by (auto simp add: execute_simps split: option.split)
lemma fails_assert'[fails_simp]: "fails (assert' P) h ⟷ ¬P"
unfolding fails_def by (auto simp add: execute_simps split: option.split)
lemma fails_bind[fails_simp]: "fails (bind m f) h ⟷ (¬fails m h ⟶ fails (f (the_res m h)) (the_heap m h))"
unfolding fails_def the_res_def the_heap_def
apply (auto simp add: execute_simps split: option.split)
using timeFrame.elims by auto
lemma fails_array_nth[fails_simp]: "fails (Array_Time.nth p i) h ⟷ ¬(i < Array_Time.length h p)"
unfolding fails_def by (auto simp add: execute_simps split: option.split)
lemma fails_array_upd[fails_simp]: "fails (Array_Time.upd i x p) h ⟷ ¬(i < Array_Time.length h p)"
unfolding fails_def by (auto simp add: execute_simps split: option.split)
lemma fails_array_len[fails_simp]: "¬fails (Array_Time.len p) h"
unfolding fails_def by (auto simp add: execute_simps split: option.split)
lemma fails_array_new[fails_simp]: "¬fails (Array_Time.new n x) h"
unfolding fails_def by (auto simp add: execute_simps split: option.split)
lemma fails_array_of_list[fails_simp]: "¬fails (Array_Time.of_list xs) h"
unfolding fails_def by (auto simp add: execute_simps split: option.split)
lemma fails_array_make[fails_simp]: "¬fails (Array_Time.make n f) h"
unfolding fails_def by (auto simp add: execute_simps split: option.split)
lemma fails_array_map_entry[fails_simp]: "fails (Array_Time.map_entry i x p) h ⟷ ¬(i < Array_Time.length h p)"
unfolding fails_def by (auto simp add: execute_simps split: option.split)
lemma fails_array_swap[fails_simp]: "fails (Array_Time.swap i x p) h ⟷ ¬(i < Array_Time.length h p)"
unfolding fails_def by (auto simp add: execute_simps split: option.split)
lemma time_return[time_simp]: "time (return x) h = 1"
unfolding time_def by (simp add: execute_simps)
lemma time_bind[time_simp]: "time (bind m f) h = (
if ¬fails m h ∧ ¬fails (f (the_res m h)) (the_heap m h) then time m h + time (f (the_res m h)) (the_heap m h)
else 0
)"
unfolding time_def the_res_def fails_def the_heap_def
by (auto simp add: execute_simps split: option.split)
lemma time_wait[time_simp]: "time (wait n) h = n"
unfolding time_def by (simp add: execute_simps)
lemma time_raise[time_simp]: "time (raise msg) h = 0"
by (auto simp: time_def execute_simps)
lemma time_assert'[time_simp]: "time (assert' P) h = 0"
unfolding time_def
by (auto simp add: execute_simps split: option.split)
lemma time_array_nth[time_simp]: "time (Array_Time.nth p i) h = (if fails (Array_Time.nth p i) h then 0 else 1)"
unfolding time_def by (auto simp add: execute_simps fails_simp split: option.split)
lemma time_array_upd[time_simp]: "time (Array_Time.upd i x p) h = (if fails (Array_Time.upd i x p) h then 0 else 1)"
unfolding time_def by (auto simp add: execute_simps fails_simp split: option.split)
lemma time_array_len[time_simp]: "time (Array_Time.len p) h = 1"
unfolding time_def by (auto simp add: execute_simps fails_simp split: option.split)
lemma time_array_new[time_simp]: "time (Array_Time.new n x) h = n+1"
unfolding time_def
by (auto simp add: execute_simps fails_simp split: option.split prod.splits)
lemma time_array_of_list[time_simp]: "time (Array_Time.of_list xs) h = length xs+1"
unfolding time_def
by (auto simp add: execute_simps fails_simp split: option.split prod.splits)
lemma time_array_make[time_simp]: "time (Array_Time.make n f) h = n+1"
unfolding time_def
by (auto simp add: execute_simps fails_simp split: option.split prod.splits)
lemma time_array_map_entry[time_simp]: "time (Array_Time.map_entry i f p) h = (if fails (Array_Time.map_entry i f p) h then 0 else 2)"
unfolding time_def by (auto simp add: execute_simps fails_simp split: option.split)
lemma time_array_swap[time_simp]: "time (Array_Time.swap i x p) h = (if fails (Array_Time.map_entry i f p) h then 0 else 2)"
unfolding time_def by (auto simp add: execute_simps fails_simp split: option.split)
lemma time_array_freeze[time_simp]: "time (Array_Time.freeze p) h = Array_Time.length h p+1"
unfolding time_def
by (auto simp add: execute_simps fails_simp split: option.split prod.splits)
subsection ‹Hoare Triple with Time›
definition htt::"assn ⇒ 'a Heap ⇒ ('a ⇒ assn) ⇒ nat⇒ bool"("<_>/ _/ <_> T/[_]") where
"htt P c Q t ≡ <P> c <Q> ∧ (∀h as. (h,as) ⊨ P ⟶ time c h ≤ t)"
lemma httI[intro?]:
assumes "<P> c <Q>"
assumes "⋀h as. (h,as) ⊨ P ⟹ time c h ≤ t"
shows "< P> c <Q>T[t]"
using assms unfolding htt_def by auto
lemma htt_refine:
assumes "< P> c <Q>T[ t]"
assumes "refines c' c"
shows " <P> c' <Q>T[ t]"
by (smt (verit, best) assms(1) assms(2) dual_order.trans fails_def
hoare_tripleE hoare_triple_refines htt_def option.simps(3) time_refines)
lemma htt_cons_rule:
assumes "<P'> c <Q'>T[t']"
" P ⟹⇩A P'"
"⋀ x. Q' x ⟹⇩A Q x" "t' ≤ t"
shows "<P>c <λ x. Q x >T[t]"
using assms cons_rule[OF assms(2,3)] unfolding htt_def
using entails_def by fastforce
lemma norm_pre_ex_rule_htt:
" (⋀x. <P x> f <Q>T[t]) ⟹ <∃⇩Ax. P x> f <Q>T[t]"
by (metis htt_def mod_ex_dist norm_pre_ex_rule)
lemma norm_post_ex_rule_htt:
" ( <P> f <(Q x)>T[t]) ⟹ <P> f <λ r. (∃⇩A x. Q x r)>T[t]"
by (meson ent_refl eq_iff htt_cons_rule triv_exI)
lemma norm_pre_pure_iff_htt:
"<P * ↑ b> f <Q>T[t] = (b ⟶ <P> f <Q>T[t])"
using htt_def by fastforce
lemma norm_pre_pure_iff_htt':
"< ↑ b*P > f <Q>T[t] = (b ⟶ <P> f <Q>T[t])"
using htt_def by fastforce
subsection ‹Proving time Bounds›
definition "TBOUND m t ≡ ∀h. time m h ≤ t"
lemma TBOUNDI[intro?]: "⟦⋀h. time m h ≤ t⟧ ⟹ TBOUND m t"
by (auto simp: TBOUND_def)
lemma TBOUNDD: "TBOUND m t ⟹ time m h ≤ t"
by (auto simp: TBOUND_def)
lemma TBOUND_eqI:
assumes "⋀h. time m h = t"
shows "TBOUND m t"
apply rule
using assms by simp
lemma TBOUND_empty: "TBOUND (Heap.Heap Map.empty) t"
unfolding TBOUND_def time_def by (simp)
lemma TBOUND_mono: "TBOUND c t ⟹ t≤t' ⟹ TBOUND c t'"
apply (auto simp: TBOUND_def)
by (meson order.trans)
lemma TBOUND_refines: "TBOUND c t ⟹ refines c d ⟹ TBOUND d t"
apply (auto simp: TBOUND_def refines_def time_def)
apply(auto split: option.split)
subgoal for h a aa b
proof-
assume 1: "∀h. (case execute c h of None ⇒ 0 | Some (x, xa, t) ⇒ t) ≤ t"
show "∀h. case execute d h of None ⇒ True | Some (r, h', t) ⇒ execute c h = Some (r, h', t) ⟹
execute d h = Some (a, aa, b) ⟹ b ≤ t "
proof-
assume 2:"∀h. case execute d h of None ⇒ True | Some (r, h', t) ⇒ execute c h = Some (r, h', t)"
show "execute d h = Some (a, aa, b) ⟹ b ≤ t "
proof-
assume "execute d h = Some (a, aa, b)"
hence "execute c h = Some (a, aa, b)" using 2
by (smt (z3) old.prod.case option.simps(5))
thus "b ≤ t" using 1
by (metis old.prod.case option.simps(5))
qed
qed
qed
done
text ‹This rule splits a Hoare-triple with time into
a Hoare-triple without time and a time-bound proof,
thus separating the proof of correctness and time.
›
lemma httI_TBOUND:
assumes "<P> c <Q>"
assumes "TBOUND c t"
shows "< P> c <Q>T[t]"
by (simp add: TBOUNDD assms(1) assms(2) httI)
lemma htt_htD:
assumes "<P> c <Q>T[t]"
shows "<P> c <Q>"
using assms htt_def by auto
subsubsection ‹Admissibility›
context begin
private lemma TBOUND_adm_aux:
"(λf. ∀xx y. f xx = Some y ⟶ (case y of (_,_,tt) ⇒ tt ≤ t x))
= (λxa. ∀h. time (Heap.Heap xa) h ≤ t x)"
apply (auto simp: fun_eq_iff time_def split: option.splits)
done
lemma TBOUND_adm: "heap.admissible (λf. ∀x. TBOUND (f x) (t x))"
unfolding TBOUND_def
apply (rule admissible_fun[OF heap_interpretation])
unfolding Heap_lub_def Heap_ord_def
apply (rule admissible_image)
subgoal
by (simp add: flat_interpretation partial_function_lift)
subgoal
apply (simp add: comp_def)
apply (fold TBOUND_adm_aux)
using option_admissible .
apply (metis Heap_execute)
by simp
end
text ‹Ad-hoc instances of admissible rule›
lemma TBOUND_fi_adm: "heap.admissible (λ fi'. ∀x xa. TBOUND (curry fi' x xa) (foo x xa))"
apply (rule ccpo.admissibleI)
apply clarsimp
apply (rule ccpo.admissibleD[OF TBOUND_adm, rule_format, where t="λ(x,xa). foo x xa" and x="(x,xa)" for x xa, simplified])
by auto
lemma TBOUND_fi'_adm: "heap.admissible (λ fi'. ∀x xa xb. TBOUND (curry (curry fi') x xa xb) (foo x xa xb))"
apply (rule ccpo.admissibleI)
apply clarsimp
apply (rule ccpo.admissibleD[OF TBOUND_adm, rule_format, where t="λ((x,xa),xb). foo x xa xb" and x="((x,xa),xb)" for x xa xb, simplified])
by auto
subsubsection ‹Syntactic Rules for \<^const>‹TBOUND››
text ‹Technical workaround:
Tag to protect a schematic variable from the simplifier's solver.
Used to simplify a term and then unify with schematic variable.
A goal of the form ‹EQ t ?t'› can be simplified, and then resolved with rule ‹EQ_refl›.
If one would run the simplifier on ‹t = ?t'›, the solver would apply @{thm refl} immediately,
not simplifying ‹t›.
›
definition "EQ a b ≡ a=b"
lemma EQI: "a=b ⟹ EQ a b" by (simp add: EQ_def)
lemma EQD: "EQ a b ⟹ a=b" by (simp add: EQ_def)
lemma EQ_refl: "EQ a a" by (simp add: EQ_def)
named_theorems TBOUND ‹Syntactic rules for time-bounds›
lemma TBOUND_bind:
assumes "TBOUND m t⇩1"
assumes "⋀x h. ⟦x = the_res m h; ¬fails m h⟧ ⟹ TBOUND (f x) t⇩2"
shows "TBOUND (do {x←m; f x}) (t⇩1 + t⇩2)"
apply (rule)
using assms[THEN TBOUNDD]
apply (auto simp add: time_simp add_mono)
done
lemma TBOUND_assert'_bind:
assumes "EQ P P'"
assumes "P ⟹ TBOUND m t"
shows "TBOUND (do {assert' P; m}) (if P' then t else 0)"
apply (rule)
using assms(2)[THEN TBOUNDD] using assms(1)[THEN EQD]
apply (auto simp add: time_simp add_mono fails_simp)
done
lemma TBOUND_assert'_weak[TBOUND]:
assumes "P ⟹ TBOUND m t"
shows "TBOUND (do {assert' P; m}) t"
apply (rule)
using assms[THEN TBOUNDD]
apply (auto simp add: time_simp add_mono fails_simp)
done
lemma TBOUND_bind_weak[TBOUND]:
assumes "TBOUND m t⇩1"
assumes "⋀x h. ⟦¬fails m h⟧ ⟹ TBOUND (f x) t⇩2"
shows "TBOUND (do {x←m; f x}) (t⇩1 + t⇩2)"
apply (rule)
using assms[THEN TBOUNDD]
apply (auto simp add: time_simp add_mono)
done
lemma TBOUND_return[TBOUND]: "TBOUND (return x) 1"
apply(rule TBOUND_eqI)
apply(simp add: time_simp)
done
lemma TBOUND_of_list[TBOUND]: "TBOUND (Array_Time.of_list xs) (Suc (length xs))"
apply(rule TBOUND_eqI)
apply(simp add: time_simp)
done
lemma TBOUND_len[TBOUND]: "TBOUND (Array_Time.len xs) 1"
apply(rule TBOUND_eqI)
apply(simp add: time_simp)
done
lemma TBOUND_nth[TBOUND]: "TBOUND (Array_Time.nth xs i) 1"
apply(rule TBOUNDI)
apply(simp add: time_simp)
done
lemma TBOUND_upd[TBOUND]: "TBOUND (Array_Time.upd xs i x) 1"
apply(rule TBOUNDI)
apply(simp add: time_simp)
done
lemma TBOUND_new[TBOUND]: "TBOUND (Array_Time.new n x) (n+1)"
apply(rule TBOUNDI)
apply(simp add: time_simp)
done
lemma TBOUND_make[TBOUND]: "TBOUND (Array_Time.make n f) (n+1)"
apply(rule TBOUNDI)
apply(simp add: time_simp)
done
lemma TBOUND_swap[TBOUND]: "TBOUND (Array_Time.swap i x a) 2"
apply(rule TBOUNDI)
apply(subst time_simp)
apply(simp)
done
lemma TBOUND_map_entry[TBOUND]: "TBOUND (Array_Time.map_entry i x a) 2"
apply(rule TBOUNDI)
apply(subst time_simp)
apply(simp)
done
lemma TBOUND_cons: " TBOUND m t⟹ EQ t t' ⟹ TBOUND m t'"
unfolding EQ_def
by simp
lemma TBOUND_if_max[TBOUND]:
assumes "P ⟹ TBOUND m bm"
assumes "¬ P ⟹ TBOUND n bn"
shows "TBOUND (if P then m else n) (max bm bn)"
using assms
apply( auto simp add: TBOUND_def max_def)
apply (meson TBOUNDD TBOUND_mono assms)
apply (meson dual_order.trans nat_le_linear)
done
lemma TBOUND_if_strong:
assumes "EQ b b'"
assumes "b ⟹ TBOUND m⇩1 t⇩1"
assumes "¬b ⟹ TBOUND m⇩2 t⇩2"
shows "TBOUND (if b then m⇩1 else m⇩2) (if b' then t⇩1 else t⇩2)"
using assms unfolding EQ_def by auto
lemma TBOUND_if:
assumes "b ⟹ TBOUND m⇩1 t⇩1"
assumes "¬b ⟹ TBOUND m⇩2 t⇩2"
shows "TBOUND (if b then m⇩1 else m⇩2) (if b then t⇩1 else t⇩2)"
using assms by auto
lemma TBOUND_Let:
assumes "⋀x. x = v ⟹ TBOUND (f x) (t x)"
shows "TBOUND (let x=v in f x) (let x=v in t x)"
using assms by auto
lemma TBOUND_Let_strong:
assumes "EQ v v'"
assumes "⋀ x. x = v ⟹ TBOUND (f x) (bnd x)"
shows " TBOUND (let x = v in f x) (let x = v' in bnd x)"
using assms unfolding EQ_def by simp
lemma TBOUND_Let_weak[TBOUND]:
assumes "⋀ x. x = v ⟹ TBOUND (f x) (bnd )"
shows " TBOUND (let x = v in f x) bnd "
using assms by simp
lemma TBOUND_option_case[TBOUND]:
assumes "t = None ⟹ TBOUND f bnd"
"⋀ x. t = Some x ⟹ TBOUND (f' x) (bnd' x)"
shows "TBOUND (case t of None ⇒ f | Some x ⇒ f' x)
(case t of None ⇒ bnd | Some x ⇒ bnd' x)"
using assms
apply(cases t)
apply auto
done
lemma TBOUND_prod_case[TBOUND]:
assumes "⋀ a b. t = (a, b) ⟹ TBOUND (f a b) (bnd a b)"
shows "TBOUND (case t of (a, b) ⇒ f a b) (case t of (a, b) ⇒ bnd a b) "
using assms apply(cases t)
by auto
lemma TBOUND_assert'_bind_strong:
assumes "P ⟹ TBOUND m t"
shows "TBOUND (do {assert' P; m}) (if P then t else 0)"
apply (rule)
using assms[THEN TBOUNDD]
apply (auto simp add: time_simp add_mono fails_simp)
done
subsubsection ‹Automation›
named_theorems TBOUND_simps
lemmas [TBOUND_simps] = if_cancel Let_const
method TBOUND_simp_EQ = ( rule EQI; (elim conjE )? ;simp only: TBOUND_simps ; fail)
method TBOUND_step_strong = (rule TBOUND_assert'_bind TBOUND_Let_strong TBOUND_if_strong, TBOUND_simp_EQ)
method TBOUND_gen_step methods fallback =
(TBOUND_step_strong |
rule TBOUND |
assumption|
rule TBOUND_cons, (rule TBOUND| assumption) |
TBOUND_simp_EQ |
fallback)
method TBOUND_step' = TBOUND_gen_step ‹simp; fail›
method TBOUND_step = TBOUND_gen_step ‹fail›
method defer_le = (rule asm_rl[of "_ ≤ _"], tactic ‹defer_tac 1›)
method TBOUND= (rule TBOUND_mono, ( TBOUND_step'+ ; fail), defer_le)
end
Theory Simple_TBOUND_Cond
theory Simple_TBOUND_Cond
imports Time_Reasoning
begin
text ‹This entry stops at showing the correctness and complexity of the operations,
but does not provide a complete or universally usable methods to reason about
programs using these operations.
In this theory, we provide an ad-hoc method, which is showcased
with a simple example later on.
›
text ‹definition of conditional TBOUND relation and setup›
definition cond_TBOUND::"assn ⇒ 'a Heap ⇒ nat⇒ bool"("§ _ §/ TBOUND/ _ _") where
"cond_TBOUND P c t ≡ (∀h as. (h,as) ⊨ P ⟶ time c h ≤ t)"
named_theorems cond_TBOUND
lemma htt_elim:
assumes "<P> c <Q>T[b]"
shows "§P§ TBOUND c b"
using assms
unfolding htt_def cond_TBOUND_def by simp
lemma htt_intro:
assumes "<P> c <Q>"
and "§P§ TBOUND c b"
shows "<P> c <Q> T[b]"
using assms unfolding htt_def cond_TBOUND_def by simp
lemma cond_TBOUND_mono: "§P§ TBOUND c b ⟹ b ≤ b' ⟹ §P§ TBOUND c b'"
unfolding cond_TBOUND_def by auto
lemma time_leq_bindy: "time c h ≤ t1 ⟹ time (d (the_res c h)) (the_heap c h) ≤ t2 ⟹
time (c ⤜ d) h ≤ t1+t2"
by (simp add: time_bind)
lemma cond_TBOUND_bind[cond_TBOUND]:
assumes "§P§ TBOUND c t1"
and "<P> c <Q>"
and "(⋀ x h. x = the_res c h ⟹ §Q x§ TBOUND (d x) t2)"
shows "§P§ TBOUND (c ⤜ d) (t1+t2)"
unfolding cond_TBOUND_def hoare_triple_def
apply auto
subgoal for h as
apply(cases "fails (d (the_res c h)) (the_heap c h)")
apply (simp add: time_bind)
apply(rule time_leq_bindy)
subgoal
using assms unfolding cond_TBOUND_def hoare_triple_def
apply auto
done
using assms(3)[of "(the_res c h)" h]
unfolding cond_TBOUND_def
using assms(2)
unfolding hoare_triple_def Let_def the_res_def the_heap_def
apply(auto split: option.split)
apply force+
done
done
lemma cond_TBOUND_return[cond_TBOUND]: "§ P § TBOUND (return x) 1"
by (simp add: cond_TBOUND_def time_return)
lemma cond_TBOUND_cons:
assumes "P ⟹⇩A Q"
and "§ Q § TBOUND c b"
shows "§ P § TBOUND c b"
using assms
unfolding cond_TBOUND_def
apply sep_auto
by (meson entailsD)
method cond_TBOUND= (rule cond_TBOUND_mono, rule cond_TBOUND)
end
Theory VEBT_Example_Setup
section ‹Setup for Usage Example›
theory VEBT_Example_Setup
imports "Time_Reasoning/Simple_TBOUND_Cond"
begin
text ‹We provide a few monadic combinators and associated reasoning rules,
that are required for our usage example.
Warning: ad-hoc and highly incomplete!
›
fun mfold where
"mfold f [] s = return s"
| "mfold f (x#xs) s = do { s ← f x s; mfold f xs s }"
fun mmap where
"mmap f [] = return []"
| "mmap f (x#xs) = do { y←f x; ys ← mmap f xs; return (y#ys) }"
definition mIf :: "bool Heap ⇒ 'a Heap ⇒ 'a Heap ⇒ 'a Heap"
("(if⇩m (_)/ then (_)/ else (_))" [0, 0, 10] 10)
where "mIf b t e ≡ do { bb ← b; if bb then t else e }"
lemma mIf_rule[sep_decon_rules]:
"<P> do { bb ← b; if bb then t else e } <Q> ⟹ <P> mIf b t e <Q>"
unfolding mIf_def by simp
abbreviation (input) pure_app (infix "$⇩m" 10) where "f $⇩m m ≡ do { x←m; return (f x) }"
lemma mmap_pure_aux:
assumes "⋀x. x∈set xs ⟹ <P> fi x <λr. P * ↑(r = f x)>"
shows "<P> mmap fi xs <λys. P * ↑(ys = map f xs )>"
using assms
proof (induction xs)
case Nil
then show ?case by sep_auto
next
case (Cons a xs)
note [sep_heap_rules] = Cons
show ?case
by sep_auto
qed
lemma mmap_pres:
assumes "⋀x. x∈set xs ⟹ <P> fi x <λr. P>"
shows "<P> mmap fi xs <λys. P >"
using assms
apply(induction xs)
apply sep_auto+
done
lemma cond_TBOUND_mIf[cond_TBOUND]:
assumes "§ P § TBOUND cond b1"
and "⋀ h. § Q (the_res cond h)§ TBOUND t b2"
and "⋀ h.§ Q (the_res cond h) § TBOUND e b3"
and "<P> cond <Q>"
shows "§ P § TBOUND (if⇩m cond then t else e) (b1 + max b2 b3)"
unfolding mIf_def
apply(rule cond_TBOUND_bind)
apply (rule assms)+
subgoal for x h
apply(auto split: if_split)
apply(rule cond_TBOUND_mono[where b = b2])
using assms apply (metis (full_types))
apply simp
apply(rule cond_TBOUND_mono[where b = b3])
using assms apply (metis (full_types))
apply simp
done
done
end
Theory VEBT_Definitions
theory VEBT_Definitions imports
Main
"HOL-Library.Extended_Nat"
"HOL-Library.Code_Target_Numeral"
"HOL-Library.Code_Target_Nat"
begin
section ‹Preliminaries and Preparations›
subsection ‹Data Type Definition›
datatype VEBT = is_Node: Node (info:"(nat*nat) option")(deg: nat)(treeList: "VEBT list") (summary:VEBT) |
is_Leaf: Leaf bool bool
hide_const (open) info deg treeList summary
locale VEBT_internal begin
subsection ‹Functions for obtaining high and low bits of an input number.›
definition high :: "nat ⇒ nat ⇒ nat" where
"high x n = (x div (2^n))"
definition low :: "nat ⇒ nat ⇒ nat" where
"low x n = (x mod (2^n))"
subsection ‹Some auxiliary lemmata›
lemma inthall[termination_simp]: "(⋀ x. x ∈ set xs ⟹ P x) ⟹ n < length xs ⟹ P (xs ! n)"
apply(induction xs arbitrary: n)
apply auto
using less_Suc_eq_0_disj
apply auto
done
lemma intind: "i < n ⟹ P x ⟹ P (replicate n x ! i)"
by (metis in_set_replicate inthall length_replicate)
lemma concat_inth:"(xs @[x]@ys)! (length xs) = x"
by simp
lemma pos_n_replace: "n<length xs ⟹ length xs = length (take n xs @ [y] @drop (Suc n) xs)"
by simp
lemma inthrepl: "i < n ⟹ (replicate n x) ! i = x" by simp
lemma nth_repl: "m<length xs ⟹ n <length xs ⟹ m≠ n ⟹(take n xs @ [x] @ drop (n+1) xs) ! m = xs ! m"
by (metis Suc_eq_plus1 append_Cons append_Nil nth_list_update_neq upd_conv_take_nth_drop)
lemma [termination_simp]:assumes "high x deg < length treeList"
shows"size (treeList ! high x deg) < Suc (size_list size treeList + size s)"
proof-
have "treeList ! high x deg ∈ set treeList"
using assms by auto
then show ?thesis
using not_less_eq size_list_estimation by fastforce
qed
subsection ‹ Auxiliary functions for defining valid Van Emde Boas Trees›
text ‹This function checks whether an element occurs in a Leaf›
fun naive_member :: "VEBT ⇒ nat ⇒ bool" where
"naive_member (Leaf a b) x = (if x = 0 then a else if x = 1 then b else False)"|
"naive_member (Node _ 0 _ _) _ = False"|
"naive_member (Node _ deg treeList s) x = (let pos = high x (deg div 2) in
(if pos < length treeList then naive_member (treeList ! pos) (low x (deg div 2)) else False))"
text ‹Test for elements stored by using the provide min-max-fields›
fun membermima :: "VEBT ⇒ nat ⇒ bool" where
"membermima (Leaf _ _) _ = False"|
"membermima (Node None 0 _ _ )_ =False"|
"membermima (Node (Some (mi,ma)) 0 _ _) x = (x = mi ∨ x = ma)"|
"membermima (Node (Some (mi, ma)) deg treeList _) x = (x = mi ∨ x = ma ∨ (
let pos = high x ( deg div 2) in (if pos < length treeList
then membermima (treeList ! pos) (low x (deg div 2)) else False)))"|
"membermima (Node None (deg) treeList _) x = (let pos = high x (deg div 2) in
(if pos < length treeList then membermima (treeList ! pos) (low x (deg div 2)) else False))"
lemma length_mul_elem:"(∀ x ∈ set xs. length x = n) ⟹ length (concat xs) = (length xs) * n"
apply(induction xs)
apply auto
done
text ‹We combine both auxiliary functions: The following test returns true if and only if an element occurs in the tree with respect to our interpretation no matter where it is stored.›
definition both_member_options :: "VEBT ⇒ nat ⇒ bool" where
"both_member_options t x = (naive_member t x ∨ membermima t x)"
end
context begin
interpretation VEBT_internal .
definition set_vebt :: "VEBT ⇒ nat set" where
"set_vebt t = {x. both_member_options t x}"
end
subsection ‹Inductive Definition of semantically valid Vam Emde Boas Trees›
text ‹Invariant for verification proofs›
context begin
interpretation VEBT_internal .
inductive invar_vebt::"VEBT ⇒ nat ⇒ bool" where
"invar_vebt (Leaf a b) (Suc 0) "|
"( ∀ t ∈ set treeList. invar_vebt t n) ⟹ invar_vebt summary m ⟹ length treeList = 2^m
⟹ m = n ⟹ deg = n + m ⟹ (∄ i. both_member_options summary i)
⟹(∀ t ∈ set treeList. ∄ x. both_member_options t x)
⟹ invar_vebt (Node None deg treeList summary) deg"|
"( ∀ t ∈ set treeList. invar_vebt t n) ⟹ invar_vebt summary m
⟹ length treeList = 2^m ⟹ m = Suc n ⟹ deg = n + m ⟹ (∄ i. both_member_options summary i)
⟹ (∀ t ∈ set treeList. ∄ x. both_member_options t x)
⟹ invar_vebt (Node None deg treeList summary) deg"|
"( ∀ t ∈ set treeList. invar_vebt t n) ⟹ invar_vebt summary m ⟹ length treeList = 2^m ⟹ m = n
⟹deg = n + m⟹ (∀ i < 2^m. (∃ x. both_member_options (treeList ! i) x) ⟷ ( both_member_options summary i)) ⟹
(mi = ma ⟶ (∀ t ∈ set treeList. ∄ x. both_member_options t x)) ⟹
mi ≤ ma ⟹ ma < 2^deg ⟹
(mi ≠ ma ⟶
(∀ i < 2^m.
(high ma n = i ⟶ both_member_options (treeList ! i) (low ma n)) ∧
(∀ x. (high x n = i ∧ both_member_options (treeList ! i) (low x n) ) ⟶ mi < x ∧ x ≤ ma) ) )
⟹ invar_vebt (Node (Some (mi, ma)) deg treeList summary) deg"|
"( ∀ t ∈ set treeList. invar_vebt t n) ⟹invar_vebt summary m ⟹ length treeList = 2^m
⟹ m = Suc n ⟹deg = n + m⟹(∀ i < 2^m. (∃ x. both_member_options (treeList ! i) x) ⟷ ( both_member_options summary i)) ⟹
(mi = ma ⟶ (∀ t ∈ set treeList. ∄ x. both_member_options t x)) ⟹
mi ≤ ma ⟹ ma < 2^deg ⟹
(mi ≠ ma ⟶
(∀ i < 2^m.
(high ma n = i ⟶ both_member_options (treeList ! i) (low ma n)) ∧
(∀ x. (high x n = i ∧ both_member_options (treeList ! i) (low x n) ) ⟶ mi < x ∧ x ≤ ma)))
⟹ invar_vebt (Node (Some (mi, ma)) deg treeList summary) deg"
end
context VEBT_internal begin
definition "in_children n treeList x ≡ both_member_options (treeList ! high x n) (low x n)"
text ‹functional validness definition›
fun valid' :: "VEBT ⇒ nat ⇒ bool" where
"valid' (Leaf _ _) d ⟷ d=1"
| "valid' (Node mima deg treeList summary) deg' ⟷
(
deg=deg' ∧ (
let n = deg div 2; m = deg - n in
( ∀ t ∈ set treeList. valid' t n )
∧ valid' summary m
∧ length treeList = 2^m
∧ (
case mima of
None ⇒ (∄ i. both_member_options summary i) ∧ (∀ t ∈ set treeList. ∄ x. both_member_options t x)
| Some (mi,ma) ⇒
mi ≤ ma ∧ ma<2^deg
∧ (∀ i < 2^m. (∃ x. both_member_options (treeList ! i) x) ⟷ ( both_member_options summary i))
∧ (if mi=ma then (∀ t ∈ set treeList. ∄ x. both_member_options t x)
else
in_children n treeList ma
∧ (∀x < 2^deg. in_children n treeList x ⟶ mi<x ∧ x≤ma)
)
)
)
)
"
text ‹equivalence proofs›
lemma high_bound_aux: "ma < 2^(n+m) ⟹ high ma n < 2^m"
unfolding high_def
by (simp add: add.commute less_mult_imp_div_less power_add)
lemma valid_eq1:
assumes "invar_vebt t d"
shows "valid' t d"
using assms apply induction
apply simp_all
apply (auto simp: in_children_def dest: high_bound_aux) []
subgoal for treeList n summary m deg mi ma
apply (intro allI impI conjI)
apply (auto simp: in_children_def dest: high_bound_aux) []
apply (metis add_Suc_right high_bound_aux power_Suc)
apply (auto simp: in_children_def dest: high_bound_aux) []
apply (metis add_Suc_right high_bound_aux power_Suc)
apply (auto simp: in_children_def dest: high_bound_aux) []
apply (metis add_Suc_right high_bound_aux power_Suc)
done
done
lemma even_odd_cases:
fixes x :: nat
obtains n where "x=n+n" | n where "x = n + Suc n"
apply (cases "even x"; simp)
apply (metis add_self_div_2 div_add)
by (metis add.commute mult_2 oddE plus_1_eq_Suc)
lemma valid_eq2: "valid' t d ⟹ invar_vebt t d"
apply (induction t d rule: valid'.induct)
apply (auto intro: invar_vebt.intros simp: Let_def split: option.splits)
subgoal for deg treeList summary
apply (rule even_odd_cases[of deg]; simp)
apply (rule invar_vebt.intros(2); simp)
apply (rule invar_vebt.intros(3); simp add: algebra_simps) by presburger
subgoal for deg treeList summary mi ma
apply (rule even_odd_cases[of deg]; simp)
subgoal
apply (rule invar_vebt.intros(4); simp?)
apply (auto simp: in_children_def) []
apply (meson le_less_linear le_less_trans)
apply (metis Euclidean_Division.div_eq_0_iff div_exp_eq gr_implies_not0 high_def)
done
subgoal
apply (rule invar_vebt.intros(5); simp?)
apply (auto) []
apply (auto) []
apply (auto simp: in_children_def) []
apply (meson le_less_linear le_less_trans)
by (metis Euclidean_Division.div_eq_0_iff add_Suc_right div_exp_eq high_def power_Suc power_eq_0_iff zero_neq_numeral)
done
done
lemma valid_eq: "valid' t d ⟷ invar_vebt t d"
using valid_eq1 valid_eq2 by auto
lemma [termination_simp]: assumes "odd (v::nat)" shows "v div 2 < v"
by (simp add: assms odd_pos)
lemma [termination_simp]:assumes "n > 1" and " odd n" shows" Suc (n div 2) < n"
by (metis Suc_lessI add_diff_cancel_left' assms(1) assms(2) div_eq_dividend_iff div_less_dividend even_Suc even_Suc_div_two odd_pos one_less_numeral_iff plus_1_eq_Suc semiring_norm(76) zero_less_diff)
end
subsection ‹Function for generating an empty tree of arbitrary degree respectively order›
context begin
interpretation VEBT_internal .
fun vebt_buildup :: "nat ⇒ VEBT" where
"vebt_buildup 0 = Leaf False False"|
"vebt_buildup (Suc 0) = Leaf False False"|
"vebt_buildup n = (if even n then (let half = n div 2 in
Node None n (replicate (2^half) (vebt_buildup half)) (vebt_buildup half))
else (let half = n div 2 in
Node None n ( replicate (2^(Suc half)) (vebt_buildup half)) (vebt_buildup (Suc half))))"
end
context VEBT_internal begin
lemma buildup_nothing_in_leaf: "¬ naive_member (vebt_buildup n) x"
proof(induction arbitrary: x rule: vebt_buildup.induct)
case 1
then show ?case by simp
next
case (2 v)
then show ?case
by simp
next
case (3 n)
let ?n = "Suc(Suc n)"
show ?case proof(cases "even ?n")
case True
let ?half = "?n div 2"
have "¬ naive_member (vebt_buildup ?half) y" for y
using "3.IH"(1) True by blast
hence 0:"∀ t ∈ set (replicate (2^?half) (vebt_buildup ?half)) . ¬ naive_member t x"
by simp
have "naive_member (vebt_buildup ?n) x ⟹ False"
proof-
assume "naive_member (vebt_buildup ?n) x"
hence "high x ?half < 2^?half ∧
naive_member ((replicate (2^?half) (vebt_buildup ?half)) ! (high x ?half)) (low x ?half)"
by (metis True vebt_buildup.simps(3) length_replicate naive_member.simps(3))
hence "∃ t ∈ set (replicate (2^?half) (vebt_buildup ?half)) . naive_member t x "
by (metis ‹⋀y. ¬ naive_member (vebt_buildup (Suc (Suc n) div 2)) y› nth_replicate)
then show False using 0 by simp
qed
then show ?thesis
by blast
next
case False
let ?half = "?n div 2"
have "¬ naive_member (vebt_buildup ?half) y" for y
using "3.IH" False by blast
hence 0:"∀ t ∈ set (replicate (2^(Suc ?half)) (vebt_buildup ?half)) . ¬ naive_member t x"
by simp
have "naive_member (vebt_buildup ?n) x ⟹ False"
proof-
assume "naive_member (vebt_buildup ?n) x"
hence "high x ?half < 2^(Suc ?half) ∧
naive_member ((replicate (2^(Suc ?half)) (vebt_buildup ?half)) ! (high x ?half)) (low x ?half)"
by (metis False vebt_buildup.simps(3) length_replicate naive_member.simps(3))
hence "∃ t ∈ set (replicate (2^(Suc ?half)) (vebt_buildup ?half)) . naive_member t x "
by (metis ‹⋀y. ¬ naive_member (vebt_buildup (Suc (Suc n) div 2)) y› nth_replicate)
then show False using 0 by simp
qed
then show ?thesis by force
qed
qed
lemma buildup_nothing_in_min_max:"¬ membermima (vebt_buildup n) x"
proof(induction arbitrary: x rule: vebt_buildup.induct)
case 1
then show ?case by simp
next
case 2
then show ?case by simp
next
case (3 va)
let ?n = "Suc (Suc va)"
let ?half = "?n div 2"
show ?case proof(cases "even ?n")
case True
have "¬ membermima (vebt_buildup ?half) y" for y
using "3.IH"(1) True by blast
hence 0:"∀ t ∈ set (replicate (2^?half) (vebt_buildup ?half)) . ¬ membermima t x"
by simp
then show ?thesis
by (metis "3.IH"(1) True vebt_buildup.simps(3) inthrepl length_replicate membermima.simps(5))
next
case False
have "¬ membermima (vebt_buildup ?half) y" for y
using "3.IH" False by blast
moreover hence 0:"∀ t ∈ set (replicate (2^(Suc ?half)) (vebt_buildup ?half)) . ¬ membermima t x"
by simp
ultimately show ?thesis
by (metis vebt_buildup.simps(3) inthrepl length_replicate membermima.simps(5))
qed
qed
text ‹The empty tree generated by $vebt_buildup$ is indeed a valid tree.›
lemma buildup_gives_valid: "n>0 ⟹ invar_vebt (vebt_buildup n) n"
proof( induction n rule: vebt_buildup.induct)
case 1
then show ?case by simp
next
case 2
then show ?case
by (simp add: invar_vebt.intros(1))
next
case (3 va)
let ?n = "Suc (Suc va)"
let ?half = "?n div 2"
show ?case proof(cases "even ?n")
case True
hence a:"vebt_buildup ?n = Node None ?n (replicate (2^?half) (vebt_buildup ?half)) (vebt_buildup ?half)" by simp
moreover hence "invar_vebt (vebt_buildup ?half) ?half"
using "3.IH"(1) True by auto
moreover hence "( ∀ t ∈ set (replicate (2^?half) (vebt_buildup ?half)). invar_vebt t ?half)" by simp
moreover have "length (replicate (2^?half) (vebt_buildup ?half)) = 2^?half" by auto
moreover have "?half+?half = ?n"
using True by auto
moreover have " ∀ t ∈ set (replicate (2^?half) (vebt_buildup ?half)). (∄ x. both_member_options t x)"
proof
fix t
assume "t ∈ set (replicate (2^?half) (vebt_buildup ?half))"
hence "t = (vebt_buildup ?half)" by simp
thus "∄ x. both_member_options t x"
by (simp add: both_member_options_def buildup_nothing_in_leaf buildup_nothing_in_min_max)
qed
moreover have " (∄ i. both_member_options (vebt_buildup ?half) i)"
using both_member_options_def buildup_nothing_in_leaf buildup_nothing_in_min_max by blast
ultimately have "invar_vebt (Node None ?n (replicate (2^?half) (vebt_buildup ?half)) (vebt_buildup ?half)) ?n"
using invar_vebt.intros(2)[of "replicate (2^?half) (vebt_buildup ?half)" ?half "vebt_buildup ?half" ?half ?n]
by simp
then show ?thesis using a by auto
next
case False
hence a:"vebt_buildup ?n = Node None ?n (replicate (2^(Suc ?half)) (vebt_buildup ?half)) (vebt_buildup (Suc ?half))" by simp
moreover hence "invar_vebt (vebt_buildup (Suc ?half)) (Suc ?half)"
using "3.IH" False by auto
moreover have "invar_vebt (vebt_buildup ?half) ?half"
using "3.IH"(3) False by auto
moreover hence "( ∀ t ∈ set (replicate (2^(Suc ?half)) (vebt_buildup ?half)). invar_vebt t ?half)" by simp
moreover have "length (replicate (2^(Suc ?half)) (vebt_buildup ?half)) = 2^(Suc ?half)" by auto
moreover have "(Suc ?half)+?half = ?n"
using False by presburger
moreover have " ∀ t ∈ set (replicate (2^(Suc ?half)) (vebt_buildup ?half)). (∄ x. both_member_options t x)"
proof
fix t
assume "t ∈ set (replicate (2^(Suc ?half)) (vebt_buildup ?half))"
hence "t = (vebt_buildup ?half)" by simp
thus "∄ x. both_member_options t x"
by (simp add: both_member_options_def buildup_nothing_in_leaf buildup_nothing_in_min_max)
qed
moreover have " (∄ i. both_member_options (vebt_buildup (Suc ?half)) i)"
using both_member_options_def buildup_nothing_in_leaf buildup_nothing_in_min_max by blast
moreover have "?half + Suc ?half = ?n"
using calculation(6) by auto
ultimately have "invar_vebt (Node None ?n (replicate (2^(Suc ?half)) (vebt_buildup ?half)) (vebt_buildup (Suc ?half))) ?n"
using invar_vebt.intros(3)[of "replicate (2^(Suc ?half)) (vebt_buildup ?half)" ?half "vebt_buildup (Suc ?half)" "Suc ?half" ?n ]
by simp
then show ?thesis using a by auto
qed
qed
lemma mi_ma_2_deg: assumes "invar_vebt (Node (Some (mi, ma)) deg treeList summary) n" shows "mi≤ ma ∧ ma < 2^deg"
proof-
from assms show ?thesis proof cases qed blast+
qed
lemma deg_not_0: "invar_vebt t n ⟹ n > 0"
apply(induction t n rule: invar_vebt.induct)
apply auto
done
lemma set_n_deg_not_0:assumes " ∀t∈set treeList. invar_vebt t n"and" length treeList = 2^m "shows " n ≥ 1"
proof-
have "length treeList > 0"
by (simp add: assms(2))
then obtain t ts where "treeList = t#ts"
by (metis list.size(3) neq_Nil_conv not_less0)
hence "invar_vebt t n"
by (simp add: assms(1))
hence "n ≥ 1"
using deg_not_0 by force
thus ?thesis by simp
qed
lemma both_member_options_ding: assumes"invar_vebt (Node info deg treeList summary) n "and "x<2^deg"and"
both_member_options (treeList ! (high x (deg div 2))) (low x (deg div 2))"shows "both_member_options (Node info deg treeList summary) x"
proof-
from assms(1) show ?thesis proof(induction "(Node info deg treeList summary)" n rule: invar_vebt.induct)
case (2 n m)
hence "membermima (treeList ! (high x (deg div 2))) (low x (deg div 2)) ∨
naive_member (treeList ! (high x (deg div 2))) (low x (deg div 2))"
using assms(3) both_member_options_def by auto
moreover hence "deg > 1"
using "2.hyps"(2) "2.hyps"(5) "2.hyps"(6) deg_not_0 by force
moreover have "high x (deg div 2)<2^m"
by (metis "2.hyps"(5) "2.hyps"(6) Euclidean_Division.div_eq_0_iff add_self_div_2 assms(2) div_exp_eq high_def power_not_zero zero_neq_one)
moreover have "membermima (treeList ! (high x (deg div 2))) (low x (deg div 2))
⟹ membermima (Node info deg treeList summary) x" using membermima.simps(5)[of "deg-1" treeList summary x]
using "2.hyps"(4) "2.hyps"(9) ‹1 < deg› ‹high x (deg div 2) < 2 ^ m› zero_le_one by fastforce
moreover have "naive_member (treeList ! (high x (deg div 2))) (low x (deg div 2))
⟹ naive_member (Node info deg treeList summary) x"
by (smt "2.hyps"(4) Suc_diff_Suc ‹1 < deg› ‹high x (deg div 2) < 2 ^ m› diff_zero le_less_trans naive_member.simps(3) zero_le_one)
ultimately show ?case
using both_member_options_def by blast
next
case (3 n m)
hence "membermima (treeList ! (high x (deg div 2))) (low x (deg div 2)) ∨
naive_member (treeList ! (high x (deg div 2))) (low x (deg div 2))"
using assms(3) both_member_options_def by auto
moreover hence "deg > 1"
by (metis "3.hyps"(1) "3.hyps"(2) "3.hyps"(4) "3.hyps"(5) "3.hyps"(6) One_nat_def Suc_lessI add_Suc add_gr_0 add_self_div_2 deg_not_0 le_imp_less_Suc plus_1_eq_Suc set_n_deg_not_0)
moreover have "high x (deg div 2)<2^m"
by (smt "3.hyps"(5) "3.hyps"(6) Euclidean_Division.div_eq_0_iff add_Suc_right add_self_div_2 assms(2) diff_Suc_1 div_exp_eq div_mult_self1_is_m even_Suc high_def odd_add odd_two_times_div_two_nat one_add_one plus_1_eq_Suc power_not_zero zero_less_Suc)
moreover have "membermima (treeList ! (high x (deg div 2))) (low x (deg div 2))
⟹ membermima (Node info deg treeList summary) x" using membermima.simps(5)[of "deg-1" treeList summary x]
using "3.hyps"(4) "3.hyps"(9) ‹1 < deg› ‹high x (deg div 2) < 2 ^ m› zero_le_one by fastforce
moreover have "naive_member (treeList ! (high x (deg div 2))) (low x (deg div 2))
⟹ naive_member (Node info deg treeList summary) x"
by (smt "3.hyps"(4) Suc_diff_Suc ‹1 < deg› ‹high x (deg div 2) < 2 ^ m› diff_zero le_less_trans naive_member.simps(3) zero_le_one)
ultimately show ?case
using both_member_options_def by blast
next
case (4 n m mi ma)
hence "membermima (treeList ! (high x (deg div 2))) (low x (deg div 2)) ∨
naive_member (treeList ! (high x (deg div 2))) (low x (deg div 2))"
using assms(3) both_member_options_def by auto
moreover hence "deg > 1"
using "4.hyps"(2) "4.hyps"(5) "4.hyps"(6) deg_not_0 by force
moreover have "high x (deg div 2)<2^m"
by (metis "4.hyps"(5) "4.hyps"(6) Euclidean_Division.div_eq_0_iff add_self_div_2 assms(2) div_exp_eq high_def power_not_zero zero_neq_one)
moreover have "membermima (treeList ! (high x (deg div 2))) (low x (deg div 2))
⟹ membermima (Node info deg treeList summary) x" using membermima.simps(5)[of "deg-1" treeList summary x]
by (smt "4.hyps"(12) "4.hyps"(4) Suc_diff_Suc calculation(2) calculation(3) diff_zero le_less_trans membermima.simps(4) zero_le_one)
moreover have "naive_member (treeList ! (high x (deg div 2))) (low x (deg div 2))
⟹ naive_member (Node info deg treeList summary) x"
by (metis "4.hyps"(4) calculation(2) calculation(3) gr_implies_not0 naive_member.simps(3) old.nat.exhaust) ultimately show ?case
using both_member_options_def by blast
next
case (5 n m mi ma)
hence "membermima (treeList ! (high x (deg div 2))) (low x (deg div 2)) ∨
naive_member (treeList ! (high x (deg div 2))) (low x (deg div 2))"
using assms(3) both_member_options_def by auto
moreover hence "deg > 1"
by (metis "5.hyps"(1) "5.hyps"(2) "5.hyps"(4) "5.hyps"(5) "5.hyps"(6) One_nat_def Suc_lessI add_Suc add_gr_0 add_self_div_2 deg_not_0 le_imp_less_Suc plus_1_eq_Suc set_n_deg_not_0)
moreover have "high x (deg div 2)<2^m"
by (metis "5.hyps"(5) "5.hyps"(6) Euclidean_Division.div_eq_0_iff add_Suc_right add_self_div_2 assms(2) div_exp_eq even_Suc_div_two even_add high_def nat.simps(3) power_not_zero)
moreover have "membermima (treeList ! (high x (deg div 2))) (low x (deg div 2))
⟹ membermima (Node info deg treeList summary) x" using membermima.simps(5)[of "deg-1" treeList summary x]
by (smt "5.hyps"(12) "5.hyps"(4) Suc_diff_Suc calculation(2) calculation(3) diff_zero le_less_trans membermima.simps(4) zero_le_one)
moreover have "naive_member (treeList ! (high x (deg div 2))) (low x (deg div 2))
⟹ naive_member (Node info deg treeList summary) x"
using "5.hyps"(4) "5.hyps"(5) "5.hyps"(6) calculation(3) by auto
ultimately show ?case
using both_member_options_def by blast
qed
qed
lemma exp_split_high_low: assumes "x < 2^(n+m)" and "n > 0" and "m> 0"
shows "high x n < 2^m" and "low x n < 2^n"
apply (metis Euclidean_Division.div_eq_0_iff assms(1) div_exp_eq high_def nat.simps(3) numeral_2_eq_2 power_not_zero)
by (simp add: low_def)
lemma low_inv: assumes "x< 2^n " shows "low (y*2^n + x) n = x" unfolding low_def
by (simp add: assms)
lemma high_inv: assumes "x< 2^n " shows "high (y*2^n + x) n = y" unfolding high_def
by (simp add: assms)
lemma both_member_options_from_chilf_to_complete_tree:
assumes "high x (deg div 2) < length treeList" and "deg ≥1" and "both_member_options (treeList ! ( high x (deg div 2))) (low x (deg div 2))"
shows "both_member_options (Node (Some (mi, ma)) deg treeList summary) x"
proof-
have "membermima (treeList ! ( high x (deg div 2))) (low x (deg div 2)) ∨
naive_member (treeList ! ( high x (deg div 2))) (low x (deg div 2))" using assms
using both_member_options_def by blast
moreover have "membermima (treeList ! ( high x (deg div 2))) (low x (deg div 2)) ⟹
membermima (Node (Some (mi, ma)) deg treeList summary) x"
using membermima.simps(4)[of mi ma "deg-1" treeList summary x]
by (metis Suc_1 Suc_leD assms(1) assms(2) le_add_diff_inverse plus_1_eq_Suc)
moreover have "naive_member (treeList ! ( high x (deg div 2))) (low x (deg div 2)) ⟹
naive_member (Node (Some (mi, ma)) deg treeList summary) x"
using naive_member.simps(3)[of "Some (mi, ma)" "deg-1" treeList summary x]
by (metis Suc_1 Suc_leD assms(1) assms(2) le_add_diff_inverse plus_1_eq_Suc)
ultimately show ?thesis
using both_member_options_def by blast
qed
lemma both_member_options_from_complete_tree_to_child:
assumes "deg ≥1" and "both_member_options (Node (Some (mi, ma)) deg treeList summary) x"
shows "both_member_options (treeList ! ( high x (deg div 2))) (low x (deg div 2)) ∨ x = mi ∨ x = ma"
proof-
have "naive_member (Node (Some (mi, ma)) deg treeList summary) x ∨
membermima (Node (Some (mi, ma)) deg treeList summary) x "
using assms(2) both_member_options_def by auto
moreover have " naive_member (Node (Some (mi, ma)) deg treeList summary) x
⟹ naive_member (treeList ! ( high x (deg div 2))) (low x (deg div 2))"
using naive_member.simps(3)[of "Some (mi, ma)" "deg-1" treeList summary x]
by (metis assms(1) le_add_diff_inverse plus_1_eq_Suc)
moreover have " membermima (Node (Some (mi, ma)) deg treeList summary) x
⟹ membermima (treeList ! ( high x (deg div 2))) (low x (deg div 2))∨ x = mi ∨ x = ma"
by (smt (z3) assms(1) le_add_diff_inverse membermima.simps(4) plus_1_eq_Suc)
ultimately show ?thesis
using both_member_options_def by presburger
qed
lemma pow_sum: "(divide::nat ⇒ nat ⇒ nat) ((2::nat) ^((a::nat)+(b::nat))) (2^a) = 2^b"
by (induction a) simp+
fun elim_dead::"VEBT ⇒ enat ⇒ VEBT" where
"elim_dead (Leaf a b) _ = Leaf a b "|
"elim_dead (Node info deg treeList summary) ∞ =
(Node info deg (map (λ t. elim_dead t (enat (2^(deg div 2)))) treeList)
(elim_dead summary ∞))"|
"elim_dead (Node info deg treeList summary) (enat l) =
(Node info deg (take (l div (2^(deg div 2))) (map (λ t. elim_dead t (enat (2^(deg div 2))))treeList))
(elim_dead summary ((enat (l div (2^(deg div 2))))))) "
lemma elimnum: "invar_vebt (Node info deg treeList summary) n ⟹
elim_dead (Node info deg treeList summary) (enat ((2::nat)^n)) = (Node info deg treeList summary)"
proof(induction rule: invar_vebt.induct)
case (1 a b)
then show ?case
by simp
next
case (2 treeList n summary m deg)
have a:"i < 2^m ⟶ (elim_dead (treeList ! i) (enat( 2^n)) = treeList ! i)" for i
proof
assume "i < 2^m"
hence "treeList ! i ∈ set treeList"
by (simp add: "2.hyps"(2))
thus "elim_dead (treeList ! i) (enat (2 ^ n)) = treeList ! i"
using "2.IH"(1) by blast
qed
hence b:"map (λ t. elim_dead t (enat (2 ^ n))) treeList = treeList"
by (simp add: "2.IH"(1) map_idI)
have "deg div 2 = n"
by (simp add: "2.hyps"(3) "2.hyps"(4))
hence "(2^m ::nat) = ( (2^deg) div (2^(deg div 2))::nat) "
using "2.hyps"(4) pow_sum by metis
hence "take (2^deg div (2^(deg div 2)))(map (λ t. elim_dead t (enat (2 ^ n))) treeList) = treeList"
using b "2"(4) by simp
moreover hence " ( elim_dead summary ((enat ((2^deg) div (2^(deg div 2)))))) = summary"
using "2.IH"(2)
by (metis ‹2 ^ m = 2 ^ deg div 2 ^ (deg div 2)›)
ultimately show ?case using elim_dead.simps(3)[of None deg treeList summary "2^deg"]
using ‹deg div 2 = n› by metis
next
case (3 treeList n summary m deg)
have a:"i < 2^m ⟶ (elim_dead (treeList ! i) (enat( 2^n)) = treeList ! i)" for i
proof
assume "i < 2^m"
hence "treeList ! i ∈ set treeList"
by (simp add: "3.hyps"(2))
thus "elim_dead (treeList ! i) (enat (2 ^ n)) = treeList ! i"
using "3.IH"(1) by blast
qed
hence b:"map (λ t. elim_dead t (enat (2 ^ n))) treeList = treeList"
by (simp add: "3.IH"(1) map_idI)
have "deg div 2 = n"
by (simp add: "3.hyps"(3) "3.hyps"(4))
hence "(2^m ::nat) = ( (2^deg) div (2^(deg div 2))::nat) "
using "3.hyps"(4) pow_sum by metis
hence "take (2^deg div (2^(deg div 2)))(map (λ t. elim_dead t (enat (2 ^ n))) treeList) = treeList"
using b "3"(4) by simp
moreover hence " ( elim_dead summary ((enat ((2^deg) div (2^(deg div 2)))))) = summary" using "3.IH"(2)
by (metis ‹2 ^ m = 2 ^ deg div 2 ^ (deg div 2)›)
ultimately show ?case using elim_dead.simps(3)[of None deg treeList summary "2^deg"]
using ‹deg div 2 = n› by metis
next
case (4 treeList n summary m deg mi ma)
have a:"i < 2^m ⟶ (elim_dead (treeList ! i) (enat( 2^n)) = treeList ! i)" for i
proof
assume "i < 2^m"
hence "treeList ! i ∈ set treeList"
by (simp add: "4.hyps"(2))
thus "elim_dead (treeList ! i) (enat (2 ^ n)) = treeList ! i"
using "4.IH"(1) by blast
qed
hence b:"map (λ t. elim_dead t (enat (2 ^ n))) treeList = treeList"
by (simp add: "4.IH"(1) map_idI)
have "deg div 2 = n"
by (simp add: "4.hyps"(3) "4.hyps"(4))
hence "(2^m ::nat) = ( (2^deg) div (2^(deg div 2))::nat) "
using "4.hyps"(4) pow_sum by metis
hence "take (2^deg div (2^(deg div 2)))(map (λ t. elim_dead t (enat (2 ^ n))) treeList) = treeList"
using b "4"(4) by simp
moreover hence " ( elim_dead summary ((enat ((2^deg) div (2^(deg div 2)))))) = summary" using "4.IH"(2)
by (metis ‹2 ^ m = 2 ^ deg div 2 ^ (deg div 2)›)
ultimately show ?case using elim_dead.simps(3)[of "Some (mi, ma)" deg treeList summary "2^deg"]
using ‹deg div 2 = n› by metis
next
case (5 treeList n summary m deg mi ma)
have a:"i < 2^m ⟶ (elim_dead (treeList ! i) (enat( 2^n)) = treeList ! i)" for i
proof
assume "i < 2^m"
hence "treeList ! i ∈ set treeList"
by (simp add: "5.hyps"(2))
thus "elim_dead (treeList ! i) (enat (2 ^ n)) = treeList ! i"
using "5.IH"(1) by blast
qed
hence b:"map (λ t. elim_dead t (enat (2 ^ n))) treeList = treeList"
by (simp add: "5.IH"(1) map_idI)
have "deg div 2 = n"
by (simp add: "5.hyps"(3) "5.hyps"(4))
hence "(2^m ::nat) = ( (2^deg) div (2^(deg div 2))::nat) "
using "5.hyps"(4) pow_sum by metis
hence "take (2^deg div (2^(deg div 2)))(map (λ t. elim_dead t (enat (2 ^ n))) treeList) = treeList"
using b "5"(4) by simp
moreover hence " ( elim_dead summary ((enat ((2^deg) div (2^(deg div 2)))))) = summary" using "5.IH"(2)
by (metis ‹2 ^ m = 2 ^ deg div 2 ^ (deg div 2)›)
ultimately show ?case using elim_dead.simps(3)[of "Some (mi, ma)" deg treeList summary "2^deg"]
using ‹deg div 2 = n› by metis
qed
lemma elimcomplete: "invar_vebt (Node info deg treeList summary) n ⟹
elim_dead (Node info deg treeList summary) ∞ = (Node info deg treeList summary)"
proof(induction rule: invar_vebt.induct)
case (1 a b)
then show ?case
by simp
next
case (2 treeList n summary m deg)
have a:"i < 2^m ⟶ (elim_dead (treeList ! i) (enat( 2^n)) = treeList ! i)" for i
proof
assume "i < 2^m"
hence "treeList ! i ∈ set treeList"
by (simp add: "2.hyps"(2))
thus "elim_dead (treeList ! i) (enat (2 ^ n)) = treeList ! i"
apply(cases "(treeList ! i)")
apply (smt (z3) "2.IH"(1) ‹treeList ! i ∈ set treeList› elim_dead.simps(1) elimnum invar_vebt.cases)+
done
qed
hence b:"map (λ t. elim_dead t (enat (2 ^ n))) treeList = treeList"
by (metis "2.hyps"(2) in_set_conv_nth map_idI)
have "deg div 2 = n"
by (simp add: "2.hyps"(3) "2.hyps"(4))
hence "(2^m ::nat) = ( (2^deg) div (2^(deg div 2))::nat) "
using "2.hyps"(4) pow_sum by metis
hence "take (2^deg div (2^(deg div 2)))(map (λ t. elim_dead t (enat (2 ^ n))) treeList) = treeList"
using b "2"(4) by simp
moreover hence " ( elim_dead summary ∞) = summary" using "2.IH"(2)
by (metis ‹2 ^ m = 2 ^ deg div 2 ^ (deg div 2)›)
ultimately show ?case using elim_dead.simps(2)[of None deg treeList summary]
using ‹deg div 2 = n› b by presburger
next
case (3 treeList n summary m deg)
have a:"i < 2^m ⟶ (elim_dead (treeList ! i) (enat( 2^n)) = treeList ! i)" for i
proof
assume "i < 2^m"
hence "treeList ! i ∈ set treeList"
by (simp add: "3.hyps"(2))
thus "elim_dead (treeList ! i) (enat (2 ^ n)) = treeList ! i"
apply(cases "(treeList ! i)")
apply (smt (z3) "3.IH"(1) ‹treeList ! i ∈ set treeList› elim_dead.simps(1) elimnum invar_vebt.cases)+
done
qed
hence b:"map (λ t. elim_dead t (enat (2 ^ n))) treeList = treeList"
by (metis "3.hyps"(2) in_set_conv_nth map_idI)
have "deg div 2 = n"
by (simp add: "3.hyps"(3) "3.hyps"(4))
hence "(2^m ::nat) = ( (2^deg) div (2^(deg div 2))::nat) "
using "3.hyps"(4) pow_sum by metis
hence "take (2^deg div (2^(deg div 2)))(map (λ t. elim_dead t (enat (2 ^ n))) treeList) = treeList"
using b "3"(4) by simp
moreover hence " ( elim_dead summary ∞) = summary" using "3.IH"(2)
by (metis ‹2 ^ m = 2 ^ deg div 2 ^ (deg div 2)›)
ultimately show ?case using elim_dead.simps(2)[of None deg treeList summary]
using ‹deg div 2 = n› b by presburger
next
case (4 treeList n summary m deg mi ma)
have a:"i < 2^m ⟶ (elim_dead (treeList ! i) (enat( 2^n)) = treeList ! i)" for i
proof
assume "i < 2^m"
hence "treeList ! i ∈ set treeList"
by (simp add: "4.hyps"(2))
thus "elim_dead (treeList ! i) (enat (2 ^ n)) = treeList ! i"
apply(cases "(treeList ! i)")
apply (smt (z3) "4.IH"(1) ‹treeList ! i ∈ set treeList› elim_dead.simps(1) elimnum invar_vebt.cases)+
done
qed
hence b:"map (λ t. elim_dead t (enat (2 ^ n))) treeList = treeList"
by (metis "4.hyps"(2) in_set_conv_nth map_idI)
have "deg div 2 = n"
by (simp add: "4.hyps"(3) "4.hyps"(4))
hence "(2^m ::nat) = ( (2^deg) div (2^(deg div 2))::nat) "
using "4.hyps"(4) pow_sum by metis
hence "take (2^deg div (2^(deg div 2)))(map (λ t. elim_dead t (enat (2 ^ n))) treeList) = treeList"
using b "4"(4) by simp
moreover hence " ( elim_dead summary ∞) = summary" using "4.IH"(2)
by (metis ‹2 ^ m = 2 ^ deg div 2 ^ (deg div 2)›)
ultimately show ?case using elim_dead.simps(2)[of "Some (mi, ma)" deg treeList summary]
using ‹deg div 2 = n› b by presburger
next
case (5 treeList n summary m deg mi ma)
have a:"i < 2^m ⟶ (elim_dead (treeList ! i) (enat( 2^n)) = treeList ! i)" for i
proof
assume "i < 2^m"
hence "treeList ! i ∈ set treeList"
by (simp add: "5.hyps"(2))
thus "elim_dead (treeList ! i) (enat (2 ^ n)) = treeList ! i"
apply(cases "(treeList ! i)")
apply (smt (z3) "5.IH"(1) ‹treeList ! i ∈ set treeList› elim_dead.simps(1) elimnum invar_vebt.cases)+
done
qed
hence b:"map (λ t. elim_dead t (enat (2 ^ n))) treeList = treeList"
by (metis "5.hyps"(2) in_set_conv_nth map_idI)
have "deg div 2 = n"
by (simp add: "5.hyps"(3) "5.hyps"(4))
hence "(2^m ::nat) = ( (2^deg) div (2^(deg div 2))::nat) "
using "5.hyps"(4) pow_sum by metis
hence "take (2^deg div (2^(deg div 2)))(map (λ t. elim_dead t (enat (2 ^ n))) treeList) = treeList"
using b "5"(4) by simp
moreover hence " ( elim_dead summary ∞) = summary" using "5.IH"(2)
by (metis ‹2 ^ m = 2 ^ deg div 2 ^ (deg div 2)›)
ultimately show ?case using elim_dead.simps(2)[of "Some (mi, ma)" deg treeList summary]
using ‹deg div 2 = n› b by presburger
qed
end
end
Theory VEBT_Member
theory VEBT_Member imports VEBT_Definitions
begin
section ‹Member Function›
context begin
interpretation VEBT_internal .
fun vebt_member :: "VEBT ⇒ nat ⇒ bool" where
"vebt_member (Leaf a b) x = (if x = 0 then a else if x = 1 then b else False)"|
"vebt_member (Node None _ _ _) x = False"|
"vebt_member (Node _ 0 _ _) x = False"|
"vebt_member (Node _ (Suc 0) _ _) x = False"|
"vebt_member (Node (Some (mi, ma)) deg treeList summary) x = (
if x = mi then True else
if x = ma then True else
if x < mi then False else
if x > ma then False else (
let h = high x (deg div 2);
l = low x (deg div 2) in(
if h < length treeList
then vebt_member (treeList ! h) l
else False))) "
end
context VEBT_internal begin
lemma member_inv:
assumes "vebt_member (Node (Some (mi, ma)) deg treeList summary) x "
shows "deg ≥ 2 ∧
(x = mi ∨ x = ma ∨ (x < ma ∧ x > mi ∧ high x (deg div 2) < length treeList ∧
vebt_member (treeList ! ( high x (deg div 2))) (low x (deg div 2))))"
proof(cases deg)
case 0
then show ?thesis using vebt_member.simps(3)[of "(mi, ma)" treeList summary x]
using assms by blast
next
case (Suc nat)
hence "deg = Suc nat" by simp
then show ?thesis proof(cases nat)
case 0
then show ?thesis
using Suc assms by auto
next
case (Suc nata)
hence "deg ≥ 2"
by (simp add: ‹deg = Suc nat›)
then show ?thesis
by (metis vebt_member.simps(5) Suc ‹deg = Suc nat› assms linorder_neqE_nat)
qed
qed
definition bit_concat::"nat ⇒ nat ⇒ nat ⇒ nat" where
"bit_concat h l d = h*2^d + l"
lemma bit_split_inv: "bit_concat (high x d) (low x d) d = x"
unfolding bit_concat_def high_def low_def
by presburger
definition set_vebt'::"VEBT ⇒ nat set" where
"set_vebt' t = {x. vebt_member t x}"
lemma Leaf_0_not: assumes "invar_vebt (Leaf a b) 0 "shows " False"
proof-
from assms show ?thesis
proof(cases)
qed
qed
lemma valid_0_not: "invar_vebt t 0 ⟹ False"
proof(induction t)
case (Node info deg treeList summary)
from this(3) have "length treeList > 0"
apply cases
apply auto
done
then obtain t where "t ∈ set treeList" by fastforce
from Node(3) obtain n where "invar_vebt t n"
apply cases
using Node.IH(2) apply auto
done
from Node(3) have "n ≤ 0"
apply cases
using Node.IH(2) apply auto
done
hence "n = 0" by blast
then show ?case
using Node.IH(1) ‹t ∈ set treeList› ‹invar_vebt t n› by blast
next
case (Leaf x1 x2)
then show ?case
using Leaf_0_not by blast
qed
theorem valid_tree_deg_neq_0: "(¬ invar_vebt t 0)"
using valid_0_not by blast
lemma deg_1_Leafy: "invar_vebt t n ⟹ n = 1 ⟹ ∃ a b. t = Leaf a b"
apply(induction rule: invar_vebt.induct)
apply simp
apply presburger
apply (metis (full_types) Suc_eq_plus1 add_cancel_right_left in_set_replicate list.map_cong0 map_replicate_const nat_neq_iff not_add_less2 numeral_1_eq_Suc_0 numeral_2_eq_2 numerals(1) order_less_irrefl power_eq_0_iff valid_tree_deg_neq_0 zero_less_numeral)
apply (metis odd_add odd_one)
by (metis Suc_eq_plus1 add_cancel_right_left in_set_replicate list.map_cong0 map_replicate_const nat_neq_iff not_add_less2 numeral_2_eq_2 power_eq_0_iff valid_tree_deg_neq_0)
lemma deg_1_Leaf: "invar_vebt t 1 ⟹ ∃ a b. t = Leaf a b"
using deg_1_Leafy by blast
corollary deg1Leaf: "invar_vebt t 1 ⟷ (∃ a b. t = Leaf a b)"
using deg_1_Leaf invar_vebt.intros(1) by auto
lemma deg_SUcn_Node: assumes "invar_vebt tree (Suc (Suc n)) " shows
" ∃ info treeList s. tree = Node info (Suc (Suc n)) treeList s"
proof-
from assms show ?thesis apply(cases)
apply blast+
done
qed
lemma "invar_vebt (Node info deg treeList summary) deg ⟹ deg > 1"
by (metis VEBT.simps(4) deg_1_Leafy less_one linorder_neqE_nat valid_tree_deg_neq_0)
lemma deg_deg_n: assumes "invar_vebt (Node info deg treeList summary) n "shows" deg = n"
proof-
from assms show ?thesis proof(cases)
qed blast+
qed
lemma member_valid_both_member_options:
"invar_vebt tree n ⟹ vebt_member tree x ⟹ (naive_member tree x ∨ membermima tree x)"
proof(induction tree n arbitrary: x rule: invar_vebt.induct)
case (1 a b)
then show ?case
using vebt_member.simps(1) naive_member.simps(1) by blast
next
case (2 treeList n summary m deg)
then show ?case by simp
next
case (3 treeList n summary m deg)
then show ?case
using vebt_member.simps(2) by blast
next
case (4 treeList n summary m deg mi ma)
hence "deg ≥ 2"
by (metis Euclidean_Division.div_eq_0_iff add_self_div_2 le_less_linear valid_tree_deg_neq_0)
then show ?case proof(cases "x = mi ∨ x = ma")
case True
then show ?thesis
by (metis (full_types) "4"(12) vebt_member.simps(3) membermima.simps(4) old.nat.exhaust)
next
case False
hence 1:"mi < x ∧ x < ma ∧ (high x (deg div 2 )) < length treeList ∧ vebt_member (treeList ! (high x (deg div 2))) (low x (deg div 2))"
using member_inv[of mi ma deg treeList summary x] "4"(12) by blast
hence " (treeList ! (high x (deg div 2))) ∈ set treeList"
by (metis in_set_member inthall)
hence "both_member_options (treeList ! (high x (deg div 2))) (low x (deg div 2))"
using "1" "4.IH"(1) both_member_options_def by blast
then show ?thesis
by (smt "1" "4"(1) "4"(6) ‹treeList ! high x (deg div 2) ∈ set treeList› membermima.simps(4) naive_member.simps(3) old.nat.exhaust valid_tree_deg_neq_0 zero_eq_add_iff_both_eq_0)
qed
next
case (5 treeList n summary m deg mi ma)
hence "deg ≥ 2"
using member_inv by presburger
then show ?case proof(cases "x = mi ∨ x = ma")
case True
then show ?thesis
by (metis (full_types) "5"(12) vebt_member.simps(3) membermima.simps(4) old.nat.exhaust)
next
case False
hence 1:"mi < x ∧ x < ma ∧ (high x (deg div 2 )) < length treeList ∧ vebt_member (treeList ! (high x (deg div 2))) (low x (deg div 2))"
using member_inv[of mi ma deg treeList summary x] "5"(12) by blast
hence " (treeList ! (high x (deg div 2))) ∈ set treeList"
by (metis in_set_member inthall)
hence "both_member_options (treeList ! (high x (deg div 2))) (low x (deg div 2))"
using "1" "5.IH"(1) both_member_options_def by blast
then show ?thesis
by (smt "1" "5"(1) "5"(6) ‹treeList ! high x (deg div 2) ∈ set treeList› membermima.simps(4) naive_member.simps(3) old.nat.exhaust valid_tree_deg_neq_0 zero_eq_add_iff_both_eq_0)
qed
qed
lemma member_bound: "vebt_member tree x ⟹ invar_vebt tree n ⟹ x < 2^n"
proof(induction tree x arbitrary: n rule: vebt_member.induct)
case (1 a b x)
then show ?case by (metis vebt_member.simps(1) One_nat_def le_neq_implies_less nat_power_eq_Suc_0_iff
numeral_eq_iff numerals(1) one_le_numeral one_le_power semiring_norm(85) valid_tree_deg_neq_0
zero_less_numeral zero_less_power)
next
case (2 uu uv uw x)
then show ?case by simp
next
case (3 v uy uz x)
then show ?case by simp
next
case (4 v vb vc x)
then show ?case by simp
next
case (5 mi ma va treeList summary x)
hence 111: "n = Suc (Suc va)"
using deg_deg_n by fastforce
hence "ma < 2^n"
using "5.prems"(2) mi_ma_2_deg by blast
then show ?case
by (metis "5.prems"(1) "5.prems"(2) le_less_trans less_imp_le_nat member_inv mi_ma_2_deg)
qed
theorem inrange: assumes "invar_vebt t n" shows " set_vebt' t ⊆ {0..2^n-1}"
proof
fix x
assume "x ∈ set_vebt' t"
hence "vebt_member t x"
using set_vebt'_def by auto
hence "x < 2^n"
using assms member_bound by blast
then show "x ∈ {0..2^n-1}" by simp
qed
theorem buildup_gives_empty: "set_vebt' (vebt_buildup n) = {}"
unfolding set_vebt'_def
by (metis Collect_empty_eq vebt_member.simps(1) vebt_member.simps(2) vebt_buildup.elims)
fun minNull::"VEBT ⇒ bool" where
"minNull (Leaf False False) = True"|
"minNull (Leaf _ _ ) = False"|
"minNull (Node None _ _ _) = True"|
"minNull (Node (Some _) _ _ _) = False"
lemma min_Null_member: "minNull t ⟹ ¬ vebt_member t x"
apply(induction t)
using vebt_member.simps(2) minNull.elims(2) apply blast
apply auto
done
lemma not_min_Null_member: "¬ minNull t ⟹ ∃ y. both_member_options t y"
proof(induction t)
case (Node info deg treeList summary)
obtain mi ma where "info = Some(mi , ma)"
by (metis Node.prems minNull.simps(4) not_None_eq surj_pair)
then show ?case
by (metis (full_types) both_member_options_def membermima.simps(3) membermima.simps(4) not0_implies_Suc)
next
case (Leaf x1 x2)
then show ?case
by (metis (full_types) both_member_options_def minNull.simps(1) naive_member.simps(1) zero_neq_one)
qed
lemma valid_member_both_member_options: "invar_vebt t n ⟹ both_member_options t x ⟹ vebt_member t x"
proof(induction t n arbitrary: x rule: invar_vebt.induct)
case (1 a b)
then show ?case
by (simp add: both_member_options_def)
next
case (2 treeList n summary m deg)
hence 0: " ( ∀ t ∈ set treeList. invar_vebt t n) " and 1:" invar_vebt summary n" and 2:" length treeList = 2^n" and
3:" deg = 2*n" and 4:" (∄ i. both_member_options summary i)" and 5:" (∀ t ∈ set treeList. ∄ y. both_member_options t y) " and 6: "n> 0"
apply blast+
apply (auto simp add: "2.hyps"(3) "2.hyps")
using "2.hyps"(1) "2.hyps"(3) neq0_conv valid_tree_deg_neq_0 by blast
have "both_member_options (Node None deg treeList summary) x ⟹ False"
proof-
assume "both_member_options (Node None deg treeList summary) x"
hence "naive_member (Node None deg treeList summary) x ∨ membermima (Node None deg treeList summary) x" unfolding both_member_options_def by simp
then show False
proof(cases "naive_member (Node None deg treeList summary) x")
case True
hence "high x n < length treeList ∧ naive_member (treeList ! (high x n)) (low x n)"
by (metis "1" "2.hyps"(3) "2.hyps"(4) add_cancel_right_left add_self_div_2 naive_member.simps(3) old.nat.exhaust valid_tree_deg_neq_0)
then show ?thesis
by (metis "5" both_member_options_def in_set_member inthall)
next
case False
hence "membermima (Node None deg treeList summary) x"
using ‹naive_member (Node None deg treeList summary) x ∨ membermima (Node None deg treeList summary) x› by blast
moreover have "Suc (deg-1) =deg"
by (simp add: "2.hyps"(4) "6")
moreover hence "(let pos = high x (deg div 2) in if pos < length treeList then membermima (treeList ! pos) (low x (Suc (deg - 1) div 2)) else False)"
using calculation(1) membermima.simps(5) by metis
moreover hence " if high x (deg div 2) < length treeList then membermima (treeList ! ( high x (deg div 2))) (low x(deg div 2)) else False"
using calculation(2) by metis
ultimately
have " high x (deg div 2) < length treeList ∧ membermima (treeList ! (high x n)) (low x n)"
by (metis "2.hyps"(3) "2.hyps"(4) add_self_div_2)
then show ?thesis using "2.IH" "5" both_member_options_def in_set_member inthall
by (metis "2.hyps"(3) "2.hyps"(4) add_self_div_2)
qed
qed
then show ?case
by (simp add: "2.prems")
next
case (3 treeList n summary m deg)
hence 0: " ( ∀ t ∈ set treeList. invar_vebt t n) " and 1:" invar_vebt summary m" and 2:" length treeList = 2^m" and
3:" deg = n+m" and 4:" (∄ i. both_member_options summary i)" and 5:" (∀ t ∈ set treeList. ∄ y. both_member_options t y) " and 6: "n> 0" and 7: "m> 0"
and 8: "n+1 = m"
apply blast+
apply (metis (full_types) "3.IH"(1) "3.hyps"(2) in_set_member inthall neq0_conv power_eq_0_iff valid_tree_deg_neq_0 zero_neq_numeral)
apply (simp add: "3.hyps"(3))
by (simp add: "3.hyps"(3))
have "both_member_options (Node None deg treeList summary) x ⟹ False"
proof-
assume "both_member_options (Node None deg treeList summary) x"
hence "naive_member (Node None deg treeList summary) x ∨ membermima (Node None deg treeList summary) x" unfolding both_member_options_def by simp
then show False
proof(cases "naive_member (Node None deg treeList summary) x")
case True
hence "high x n < length treeList ∧ naive_member (treeList ! (high x n)) (low x n)"
by (metis "3" "3.hyps"(3) add_Suc_right add_self_div_2 even_Suc_div_two naive_member.simps(3) odd_add)
then show ?thesis
by (metis "5" both_member_options_def in_set_member inthall)
next
case False
hence "membermima (Node None deg treeList summary) x"
using ‹naive_member (Node None deg treeList summary) x ∨ membermima (Node None deg treeList summary) x› by blast
moreover have "Suc (deg-1) =deg"
by (simp add: "3" "3.hyps"(3))
moreover hence "(let pos = high x (deg div 2) in if pos < length treeList then membermima (treeList ! pos) (low x (Suc (deg - 1) div 2)) else False)"
using calculation(1) membermima.simps(5) by metis
moreover hence 11:" if high x (deg div 2) < length treeList then membermima (treeList ! ( high x (deg div 2))) (low x(deg div 2)) else False"
using calculation(2) by metis
ultimately
have " high x (deg div 2) < length treeList ∧ membermima (treeList ! (high x n)) (low x n)"
by (metis "3" "3.hyps"(3) add_Suc_right add_self_div_2 even_Suc_div_two odd_add)
then show ?thesis using "3.IH" "5" both_member_options_def in_set_member inthall 11 by metis
qed
qed
then show ?case
using "3.prems" by blast
next
case (4 treeList n summary m deg mi ma)
hence 0: "( ∀ t ∈ set treeList. invar_vebt t n)" and 1: " invar_vebt summary n" and 2:"length treeList = 2^n" and 3:" deg = n+m" and "n=m" and
4: "(∀ i < 2^n. (∃ y. both_member_options (treeList ! i) y) ⟷ ( both_member_options summary i))" and
5: "(mi = ma ⟶ (∀ t ∈ set treeList. ∄ y. both_member_options t y))" and 6:"mi ≤ ma ∧ ma < 2^deg" and
7: "(mi ≠ ma ⟶ (∀ i < 2^m. (high ma n = i ⟶ both_member_options (treeList ! i) (low ma n)) ∧
(∀ y. (high y n = i ∧ both_member_options (treeList ! i) (low y n) ) ⟶ mi < y ∧ y ≤ ma)))"
using "4.prems" by auto
hence "n>0"
by (metis neq0_conv valid_tree_deg_neq_0)
then show ?case proof(cases "x = mi ∨ x = ma")
case True
hence xmimastmt: "x = mi ∨ x=ma" by simp
then show ?thesis using vebt_member.simps(5)[of mi ma "deg-2" treeList summary x]
by (metis "3" "4.hyps"(3) ‹0 < n› add_diff_inverse_nat add_numeral_left add_self_div_2 div_if nat_neq_iff numerals(1) plus_1_eq_Suc semiring_norm(2))
next
case False
hence xmimastmt: "x ≠ mi ∧ x≠ma" by simp
hence "mi = ma ⟹ False"
proof-
assume "mi = ma"
hence astmt: "(∀ t ∈ set treeList. ∄ y. both_member_options t y)" using 5 by simp
have bstmt: "both_member_options (Node (Some (mi, ma)) deg treeList summary) x"
by (simp add: "4.prems")
then show False
proof(cases "naive_member (Node (Some (mi, ma)) deg treeList summary) x")
case True
hence "high x n < length treeList ∧ naive_member (treeList ! (high x n)) (low x n)"
by (metis (no_types, hide_lams) "3" "4.hyps"(1) "4.hyps"(3) add_self_div_2 naive_member.simps(3) old.nat.exhaust valid_0_not zero_eq_add_iff_both_eq_0)
then show ?thesis
by (metis "5" ‹mi = ma› both_member_options_def in_set_member inthall)
next
case False
hence "membermima (Node (Some (mi, ma)) deg treeList summary) x" using bstmt unfolding both_member_options_def by blast
hence " x = mi ∨ x = ma ∨ (if high x n < length treeList then membermima (treeList ! (high x n)) (low x n) else False)"
using membermima.simps(4)[of mi ma "deg-1" treeList summary x]
by (metis "3" "4.hyps"(3) One_nat_def Suc_diff_Suc ‹0 < n› add_gr_0 add_self_div_2 diff_zero)
hence " high x n < length treeList ∧ membermima (treeList ! (high x n)) (low x n)" using xmimastmt
by presburger
then show ?thesis using both_member_options_def in_set_member inthall membermima.simps(4)[of mi ma n treeList summary x] astmt
by metis
qed
qed
hence "mi ≠ ma " by blast
hence followstmt: "(∀ i < 2^m. (high ma n = i ⟶ both_member_options (treeList ! i) (low ma n)) ∧
(∀ y. (high y n = i ∧ both_member_options (treeList ! i) (low y n) ) ⟶ mi < y ∧ y ≤ ma))"
using 7 by simp
have 10:"high x n < length treeList ∧
(naive_member (treeList ! (high x n)) (low x n) ∨ membermima (treeList ! (high x n)) (low x n) )"
by (smt "3" "4.hyps"(3) "4.prems" False One_nat_def Suc_leI ‹0 < n› add_gr_0 add_self_div_2 both_member_options_def le_add_diff_inverse membermima.simps(4) naive_member.simps(3) plus_1_eq_Suc)
hence 11:"both_member_options (treeList ! (high x n)) (low x n)"
by (simp add: both_member_options_def)
have 12:"high x n< 2^m"
using "10" "4.hyps"(2) by auto
hence "mi < x ∧ x < ma" proof-
have "(∀ y. (high y n = (high x n) ∧ both_member_options (treeList ! (high y n)) (low y n) ) ⟶ mi < y ∧ y ≤ ma)"
using "12" followstmt by auto
then show ?thesis
using "11" False order.not_eq_order_implies_strict by blast
qed
have "vebt_member (treeList ! (high x n)) (low x n)"
by (metis"10" "11" "4.IH"(1) in_set_member inthall)
then show ?thesis
by (smt "10" "11" "12" "3" "4.hyps"(3) vebt_member.simps(5) One_nat_def Suc_leI ‹0 < n› add_Suc_right add_self_div_2 followstmt le_add_diff_inverse le_imp_less_Suc not_less_eq not_less_iff_gr_or_eq plus_1_eq_Suc)
qed
next
case (5 treeList n summary m deg mi ma)
hence 0: "( ∀ t ∈ set treeList. invar_vebt t n)" and 1: " invar_vebt summary m" and 2:"length treeList = 2^m" and 3:" deg = n+m" and "Suc n=m" and
4: "(∀ i < 2^m. (∃ y. both_member_options (treeList ! i) y) ⟷ ( both_member_options summary i))" and
5: "(mi = ma ⟶ (∀ t ∈ set treeList. ∄ y. both_member_options t y))" and 6:"mi ≤ ma ∧ ma < 2^deg" and
7: "(mi ≠ ma ⟶ (∀ i < 2^m. (high ma n = i ⟶ both_member_options (treeList ! i) (low ma n)) ∧
(∀ y. (high y n = i ∧ both_member_options (treeList ! i) (low y n) ) ⟶ mi < y ∧ y ≤ ma)))"
using "5.prems" by auto
hence "n>0"
by (metis "5.hyps"(3) in_set_member inthall neq0_conv power_Suc0_right valid_tree_deg_neq_0 zero_neq_numeral)
then show ?case proof(cases "x = mi ∨ x = ma")
case True
hence xmimastmt: "x = mi ∨ x=ma" by simp
then show ?thesis using vebt_member.simps(5)[of mi ma "deg-2" treeList summary x]
using "3" "5.hyps"(3) ‹0 < n› by auto
next
case False
hence xmimastmt: "x ≠ mi ∧ x≠ma" by simp
hence "mi = ma ⟹ False"
proof-
assume "mi = ma"
hence astmt: "(∀ t ∈ set treeList. ∄ y. both_member_options t y)" using 5 by simp
have bstmt: "both_member_options (Node (Some (mi, ma)) deg treeList summary) x"
by (simp add: "5.prems")
then show False
proof(cases "naive_member (Node (Some (mi, ma)) deg treeList summary) x")
case True
hence "high x n < length treeList ∧ naive_member (treeList ! (high x n)) (low x n)"
by (metis "3" "5.hyps"(3) add_Suc_right add_self_div_2 even_Suc_div_two naive_member.simps(3) odd_add)
then show ?thesis
by (metis "5" ‹mi = ma› both_member_options_def in_set_member inthall)
next
case False
hence "membermima (Node (Some (mi, ma)) deg treeList summary) x" using bstmt unfolding both_member_options_def by blast
hence " x = mi ∨ x = ma ∨ (if high x n < length treeList then membermima (treeList ! (high x n)) (low x n) else False)"
using membermima.simps(4)[of mi ma "deg-1" treeList summary x]
using "3" "5.hyps"(3) by auto
hence " high x n < length treeList ∧ membermima (treeList ! (high x n)) (low x n)" using xmimastmt
by presburger
then show ?thesis using both_member_options_def in_set_member inthall membermima.simps(4)[of mi ma n treeList summary x] astmt
by metis
qed
qed
hence "mi ≠ ma " by blast
hence followstmt: "(∀ i < 2^m. (high ma n = i ⟶ both_member_options (treeList ! i) (low ma n)) ∧
(∀ y. (high y n = i ∧ both_member_options (treeList ! i) (low y n) ) ⟶ mi < y ∧ y ≤ ma))"
using 7 by simp
have 10:"high x n < length treeList ∧
(naive_member (treeList ! (high x n)) (low x n) ∨ membermima (treeList ! (high x n)) (low x n) )"
by (smt "3" "5.hyps"(3) "5.prems" False add_Suc_right add_self_div_2 both_member_options_def even_Suc_div_two membermima.simps(4) naive_member.simps(3) odd_add)
hence 11:"both_member_options (treeList ! (high x n)) (low x n)"
by (simp add: both_member_options_def)
have 12:"high x n< 2^m"
using "10" "5.hyps"(2) by auto
hence "mi < x ∧ x < ma" proof-
have "(∀ y. (high y n = (high x n) ∧ both_member_options (treeList ! (high y n)) (low y n) ) ⟶ mi < y ∧ y ≤ ma)"
using "12" followstmt by auto
then show ?thesis
using "11" False order.not_eq_order_implies_strict by blast
qed
have "vebt_member (treeList ! (high x n)) (low x n)"
by (metis "10" "11" "5.IH"(1) in_set_member inthall)
then show ?thesis
by (smt "10" "11" "12" "3" "5.hyps"(3) vebt_member.simps(5) Suc_pred ‹0 < n› add_Suc_right add_self_div_2 even_Suc_div_two followstmt le_neq_implies_less not_less_iff_gr_or_eq odd_add)
qed
qed
corollary both_member_options_equiv_member: assumes "invar_vebt t n"
shows "both_member_options t x ⟷ vebt_member t x"
using assms both_member_options_def member_valid_both_member_options valid_member_both_member_options by blast
lemma member_correct: "invar_vebt t n ⟹ vebt_member t x ⟷ x ∈ set_vebt t "
using both_member_options_equiv_member set_vebt_def by auto
corollary set_vebt_set_vebt'_valid: assumes "invar_vebt t n" shows "set_vebt t =set_vebt' t"
unfolding set_vebt_def set_vebt'_def
apply auto
using assms valid_member_both_member_options apply auto[1]
using assms both_member_options_equiv_member by auto
lemma set_vebt_finite: "invar_vebt t n ⟹ finite (set_vebt' t)"
using finite_subset inrange by blast
lemma mi_eq_ma_no_ch:assumes "invar_vebt (Node (Some (mi, ma)) deg treeList summary) deg " and " mi = ma "
shows "(∀ t ∈ set treeList. ∄ x. both_member_options t x ) ∧ (∄ x. both_member_options summary x)"
proof-
from assms(1) show ?thesis
proof(cases)
case (4 n m)
have 0:"∀t∈set treeList. ¬ Ex (both_member_options t)"
by (simp add: "4"(7) assms(2))
moreover have "both_member_options summary x ⟹ False" for x
proof-
assume "both_member_options summary x "
hence "vebt_member summary x"
using "4"(2) valid_member_both_member_options by auto
moreover hence "x < 2^m"
using "4"(2) member_bound by auto
ultimately have "∃ y. both_member_options (treeList ! (high x n)) y"
using "0" "4"(3) "4"(4) "4"(6) ‹both_member_options summary x› inthall
by (metis nth_mem)
then show ?thesis
by (metis "0" "4"(3) "4"(4) Euclidean_Division.div_eq_0_iff ‹x < 2 ^ m› high_def nth_mem zero_less_numeral zero_less_power)
qed
then show ?thesis
using calculation by blast
next
case (5 n m)
have 0:"∀t∈set treeList. ¬ Ex (both_member_options t)"
using "5"(7) assms(2) by blast
moreover have "both_member_options summary x ⟹ False" for x
proof-
assume "both_member_options summary x "
hence "vebt_member summary x"
using "5"(2) valid_member_both_member_options by auto
moreover hence "x < 2^m"
using "5"(2) member_bound by auto
ultimately have "∃ y. both_member_options (treeList ! (high x n)) y"
using "0" "5"(3) "5"(4) "5"(6) ‹both_member_options summary x› inthall
by (metis nth_mem)
then show ?thesis
by (metis "0" "5"(3) "5"(6) ‹both_member_options summary x› ‹x < 2 ^ m› nth_mem)
qed
then show ?thesis
using calculation by blast
qed
qed
end
end
Theory VEBT_Insert
theory VEBT_Insert imports VEBT_Member
begin
section ‹Insert Function›
context begin
interpretation VEBT_internal .
fun vebt_insert :: "VEBT ⇒ nat ⇒VEBT" where
"vebt_insert (Leaf a b) x = (if x=0 then Leaf True b else if x = 1 then Leaf a True else Leaf a b)"|
"vebt_insert (Node info 0 ts s) x = (Node info 0 ts s)"|
"vebt_insert (Node info (Suc 0) ts s) x = (Node info (Suc 0) ts s)"|
"vebt_insert (Node None (Suc deg) treeList summary) x =
(Node (Some (x,x)) (Suc deg) treeList summary)"|
"vebt_insert (Node (Some (mi,ma)) deg treeList summary) x = (
let xn = (if x < mi then mi else x);
minn = (if x < mi then x else mi);
l = low xn (deg div 2);
h = high xn (deg div 2) in (
if h < length treeList ∧ ¬ (x = mi ∨ x = ma) then
Node (Some (minn, max xn ma)) deg (treeList[h:= vebt_insert (treeList ! h) l])
(if minNull (treeList ! h) then vebt_insert summary h else summary)
else (Node (Some (mi, ma)) deg treeList summary)))"
end
context VEBT_internal begin
lemma insert_simp_norm:
assumes "high x (deg div 2) < length treeList " and "(mi::nat)< x" and "deg≥ 2" and "x ≠ ma"
shows "vebt_insert (Node (Some (mi,ma)) deg treeList summary) x =
Node (Some (mi, max x ma)) deg (treeList [(high x (deg div 2)):= vebt_insert (treeList ! (high x (deg div 2))) (low x (deg div 2))])
(if minNull (treeList ! (high x (deg div 2))) then vebt_insert summary (high x (deg div 2)) else summary) "
proof-
have 11:"vebt_insert (Node (Some (mi,ma)) deg treeList summary) x =
(let xn = (if x < mi then mi else x); minn = (if x< mi then x else mi);
l= low xn (deg div 2); h = high xn (deg div 2)
in
( if h < length treeList ∧ ¬ (x = mi ∨ x = ma)then
Node (Some (minn, max xn ma)) deg (treeList [h:= vebt_insert (treeList ! h) l])
(if minNull (treeList ! h) then vebt_insert summary h else summary)
else (Node (Some (mi, ma)) deg treeList summary)))"
using assms(3) vebt_insert.simps(5)[of mi ma "deg-2" treeList summary x]
by (smt add_numeral_left le_add_diff_inverse numerals(1) plus_1_eq_Suc semiring_norm(2))
have 14:"vebt_insert (Node (Some (mi,ma)) deg treeList summary) x =
Node (Some (mi, max x ma)) deg (treeList[(high x (deg div 2)) := vebt_insert (treeList ! (high x (deg div 2))) (low x (deg div 2))])
(if minNull (treeList ! (high x (deg div 2))) then vebt_insert summary (high x (deg div 2)) else summary)"
using 11 apply (simp add: Let_def)
apply (auto simp add: If_def)
using assms not_less_iff_gr_or_eq apply blast+
done
then show ?thesis by blast
qed
lemma insert_simp_excp:
assumes "high mi (deg div 2) < length treeList " and " (x::nat) < mi" and "deg≥ 2" and "x ≠ ma"
shows "vebt_insert (Node (Some (mi,ma)) deg treeList summary) x =
Node (Some (x, max mi ma)) deg (treeList[(high mi (deg div 2)) := vebt_insert (treeList ! (high mi (deg div 2))) (low mi (deg div 2))])
(if minNull (treeList ! (high mi (deg div 2))) then vebt_insert summary (high mi (deg div 2)) else summary) "
proof-
have 11:"vebt_insert (Node (Some (mi,ma)) deg treeList summary) x =
( let xn = (if x < mi then mi else x); minn = (if x< mi then x else mi);
l= low xn (deg div 2); h = high xn (deg div 2)
in
( if h < length treeList ∧ ¬ (x = mi ∨ x = ma)then
Node (Some (minn, max xn ma)) deg (treeList[h:=vebt_insert (treeList ! h) l])
(if minNull (treeList ! h) then vebt_insert summary h else summary)
else (Node (Some (mi, ma)) deg treeList summary)))"
using assms(3) vebt_insert.simps(5)[of mi ma "deg-2" treeList summary x]
by (smt add_numeral_left le_add_diff_inverse numerals(1) plus_1_eq_Suc semiring_norm(2))
have 14:"vebt_insert (Node (Some (mi,ma)) deg treeList summary) x =
Node (Some (x, max mi ma)) deg ( treeList[ (high mi (deg div 2)) := vebt_insert (treeList ! (high mi (deg div 2))) (low mi (deg div 2))])
(if minNull (treeList ! (high mi (deg div 2))) then vebt_insert summary (high mi (deg div 2)) else summary)"
using 11 apply (simp add: Let_def)
apply (auto simp add: If_def)
using assms not_less_iff_gr_or_eq apply blast+
done
then show ?thesis by blast
qed
lemma insert_simp_mima: assumes "x = mi ∨ x = ma" and "deg ≥ 2"
shows "vebt_insert (Node (Some (mi,ma)) deg treeList summary) x = (Node (Some (mi,ma)) deg treeList summary)"
proof -
have 11:"vebt_insert (Node (Some (mi,ma)) deg treeList summary) x =
( let xn = (if x < mi then mi else x); minn = (if x< mi then x else mi);
l= low xn (deg div 2); h = high xn (deg div 2)
in
( if h < length treeList ∧ ¬ (x = mi ∨ x = ma)then
Node (Some (minn, max xn ma)) deg (treeList[h:= vebt_insert (treeList ! h) l])
(if minNull (treeList ! h) then vebt_insert summary h else summary)
else (Node (Some (mi, ma)) deg treeList summary)))" using assms vebt_insert.simps(5)[of mi ma "deg-2" treeList summary x]
by (smt add_numeral_left le_add_diff_inverse numerals(1) plus_1_eq_Suc semiring_norm(2))
then show ?thesis
using assms(1) by auto
qed
lemma valid_insert_both_member_options_add: "invar_vebt t n ⟹ x< 2^n ⟹ both_member_options (vebt_insert t x) x"
proof(induction t n arbitrary: x rule: invar_vebt.induct)
case (1 a b)
then show ?case apply(cases x)
by (auto simp add: both_member_options_def)
next
case (2 treeList n summary m deg)
hence "deg>1"
using valid_tree_deg_neq_0
by (metis One_nat_def Suc_lessI add_gr_0 add_self_div_2 neq0_conv one_div_two_eq_zero)
then show ?case using vebt_insert.simps(4)[of "deg-2" treeList summary x ]
by (smt Suc_1 Suc_leI add_numeral_left both_member_options_def le_add_diff_inverse membermima.simps(4)
numerals(1) plus_1_eq_Suc semiring_norm(2))
next
case (3 treeList n summary m deg)
hence "∀t∈set treeList. invar_vebt t n" by blast
hence "n > 0" using set_n_deg_not_0[of treeList n m] "3"(4)
by linarith
hence "deg ≥ 2"
by (simp add: "3.hyps"(3) "3.hyps"(4) Suc_leI)
then show ?case using vebt_insert.simps(4)[of "deg-2" treeList summary x ]
by (smt Suc_1 Suc_leI add_numeral_left both_member_options_def le_add_diff_inverse membermima.simps(4)
numerals(1) plus_1_eq_Suc semiring_norm(2))
next
case (4 treeList n summary m deg mi ma)
hence "length treeList =2^n" by blast
hence "high x n < length treeList"
using "4.hyps"(1) "4.hyps"(3) "4.hyps"(4) "4.prems" deg_not_0 exp_split_high_low(1) by auto
hence "mi < 2^deg"
using "4.hyps"(7) "4.hyps"(8) le_less_trans by blast
then show ?case
proof(cases "x = mi ∨ x = ma")
case True
then show ?thesis using vebt_insert.simps(5)[of mi ma "deg-2" treeList summary x]
by (smt "4.hyps"(1) "4.hyps"(3) "4.hyps"(4) add_diff_inverse_nat add_numeral_left add_self_div_2 both_member_options_def div_if membermima.simps(4) numerals(1) plus_1_eq_Suc semiring_norm(2) valid_tree_deg_neq_0)
next
case False
hence "¬ (x = mi ∨ x = ma)" by simp
then show ?thesis
proof(cases "x < mi")
case True
hence "high mi n < length treeList"
using "4.hyps"(1) "4.hyps"(2) "4.hyps"(3) "4.hyps"(4) ‹mi < 2 ^ deg› deg_not_0 exp_split_high_low(1) by auto
hence "vebt_insert ( Node (Some (mi, ma)) deg treeList summary) x =
Node (Some (x, max mi ma)) deg ( treeList[(high mi n):= vebt_insert (treeList ! (high mi n)) (low mi n)] )
(if minNull (treeList ! high mi n) then vebt_insert summary (high mi n) else summary)"
by (metis "4.hyps"(1) "4.hyps"(3) "4.hyps"(4) False True add_self_div_2 div_if insert_simp_excp not_less valid_tree_deg_neq_0)
then show ?thesis
by (smt "4.hyps"(1) "4.hyps"(4) Suc_pred add_diff_inverse_nat both_member_options_def membermima.simps(4) valid_tree_deg_neq_0 zero_eq_add_iff_both_eq_0)
next
case False
hence "vebt_insert ( Node (Some (mi, ma)) deg treeList summary) x =
Node (Some (mi, max x ma)) deg (treeList[ (high x n):=vebt_insert (treeList ! (high x n)) (low x n)])
(if minNull (treeList ! high x n) then vebt_insert summary (high x n) else summary)"
by (metis "4.hyps"(1) "4.hyps"(3) "4.hyps"(4) ‹¬ (x = mi ∨ x = ma)› ‹high x n < length treeList› add_self_div_2 div_if insert_simp_norm linorder_neqE_nat not_less valid_tree_deg_neq_0)
have "low x n < 2^n ∧ high x n < 2^n"
using "4.hyps"(2) "4.hyps"(3) ‹high x n < length treeList› low_def by auto
have "invar_vebt (treeList ! (high x n)) n"
by (metis "4.IH"(1) ‹high x n < length treeList› inthall member_def)
hence "both_member_options (vebt_insert (treeList ! (high x n)) (low x n)) (low x n)"
by (simp add: "4.IH"(1) ‹high x n < length treeList› low_def)
have " (treeList[ (high x n):=vebt_insert (treeList ! (high x n)) (low x n)]) ! (high x n) = vebt_insert (treeList ! (high x n)) (low x n)"
by (simp add: ‹high x n < length treeList›)
then show ?thesis
using both_member_options_ding[of "Some (mi, max x ma)" deg
"(take (high x n) treeList @ [vebt_insert (treeList ! (high x n)) (low x n)] @ drop (high x n +1) treeList)"
"if minNull (treeList ! high x n) then vebt_insert summary (high x n) else summary" n x]
by (metis "4.hyps"(2) "4.hyps"(3) "4.hyps"(4) Suc_1 Suc_leD
‹vebt_insert (Node (Some (mi, ma)) deg treeList summary) x = Node (Some (mi, max x ma)) deg (treeList[high x n := vebt_insert (treeList ! high x n) (low x n)]) (if minNull (treeList ! high x n) then vebt_insert summary (high x n) else summary)› ‹both_member_options (vebt_insert (treeList ! high x n) (low x n)) (low x n)› ‹low x n < 2 ^ n ∧ high x n < 2 ^ n› ‹invar_vebt (treeList ! high x n) n› add_self_div_2 both_member_options_from_chilf_to_complete_tree deg_not_0 div_greater_zero_iff length_list_update)
qed
qed
next
case (5 treeList n summary m deg mi ma)
hence "length treeList =2^m" by blast
hence "high x n < length treeList"
by (metis "5.hyps"(4) "5.prems" Euclidean_Division.div_eq_0_iff div_exp_eq high_def length_0_conv length_greater_0_conv zero_less_numeral zero_less_power)
hence "mi<2^deg"
using "5.hyps"(7) "5.hyps"(8) le_less_trans by blast
then show ?case
proof(cases "x = mi ∨ x = ma")
case True
then show ?thesis using vebt_insert.simps(5)[of mi ma "deg-2" treeList summary x]
by (smt "5.hyps"(3) "5.hyps"(4) Suc_leI add_Suc_right add_diff_inverse_nat add_numeral_left both_member_options_def diff_is_0_eq' vebt_insert.simps(3) membermima.simps(4) not_add_less1 numerals(1) plus_1_eq_Suc semiring_norm(2))
next
case False
hence "¬ (x = mi ∨ x = ma)" by simp
then show ?thesis
proof(cases "x < mi")
case True
hence "high mi n < length treeList"
by (metis "5.hyps"(2) "5.hyps"(4) Euclidean_Division.div_eq_0_iff ‹mi < 2 ^ deg› div_exp_eq high_def length_0_conv length_greater_0_conv zero_less_numeral zero_less_power)
hence "vebt_insert ( Node (Some (mi, ma)) deg treeList summary) x =
Node (Some (x, max mi ma)) deg ( treeList[ (high mi n):=vebt_insert (treeList ! (high mi n)) (low mi n)] )
(if minNull (treeList ! high mi n) then vebt_insert summary (high mi n) else summary)"
using insert_simp_excp[of mi deg treeList x ma summary]
"5"(1) "5.hyps"(3) "5.hyps"(4) False True add_Suc_right add_self_div_2
append_Cons div_less even_Suc_div_two in_set_conv_decomp not_less odd_add valid_tree_deg_neq_0
by (smt (z3) nth_mem)
then show ?thesis
by (simp add: "5.hyps"(3) "5.hyps"(4) both_member_options_def)
next
case False
hence "vebt_insert ( Node (Some (mi, ma)) deg treeList summary) x =
Node (Some (mi, max x ma)) deg (treeList[(high x n):= vebt_insert (treeList ! (high x n)) (low x n)])
(if minNull (treeList ! high x n) then vebt_insert summary (high x n) else summary)"
by (smt (z3) "5.IH"(1) "5.hyps"(3) "5.hyps"(4) ‹¬ (x = mi ∨ x = ma)› ‹high x n < length treeList› add_Suc_right add_self_div_2 deg_not_0 div_greater_zero_iff even_Suc_div_two insert_simp_norm linorder_neqE_nat nth_mem odd_add)
have "low x n < 2^n ∧ high x n < 2^m"
using "5.hyps"(2) "5.hyps"(3) ‹high x n < length treeList› low_def by auto
have "invar_vebt (treeList ! (high x n)) n"
by (metis "5.IH"(1) ‹high x n < length treeList› inthall member_def)
hence "both_member_options (vebt_insert (treeList ! (high x n)) (low x n)) (low x n)"
by (metis "5.IH"(1) ‹high x n < length treeList› ‹low x n < 2 ^ n ∧ high x n < 2 ^ m› inthall member_def)
have " (treeList[ (high x n):=vebt_insert (treeList ! (high x n)) (low x n)]) ! (high x n) = vebt_insert (treeList ! (high x n)) (low x n)"
by (meson ‹high x n < length treeList› nth_list_update_eq)
then show ?thesis
using both_member_options_ding[of "Some (mi, max x ma)" deg
"(treeList[ (high x n):=vebt_insert (treeList ! (high x n)) (low x n)])"
"if minNull (treeList ! high x n) then vebt_insert summary (high x n) else summary" n x]
using "5.hyps"(2) "5.hyps"(3) "5.hyps"(4) ‹vebt_insert (Node (Some (mi, ma)) deg treeList summary) x = Node (Some (mi, max x ma)) deg (treeList[high x n := vebt_insert (treeList ! high x n) (low x n)]) (if minNull (treeList ! high x n) then vebt_insert summary (high x n) else summary)› ‹both_member_options (vebt_insert (treeList ! high x n) (low x n)) (low x n)› ‹low x n < 2 ^ n ∧ high x n < 2 ^ m› both_member_options_from_chilf_to_complete_tree by auto
qed
qed
qed
lemma valid_insert_both_member_options_pres: "invar_vebt t n ⟹ x<2^n ⟹ y < 2^n ⟹ both_member_options t x
⟹ both_member_options (vebt_insert t y) x"
proof(induction t n arbitrary: x y rule: invar_vebt.induct)
case (1 a b)
then show ?case by (simp add: both_member_options_def)
next
case (2 treeList n summary m deg)
then show ?case
using vebt_member.simps(2) invar_vebt.intros(2) valid_member_both_member_options by blast
next
case (3 treeList n summary m deg)
then show ?case
using vebt_member.simps(2) invar_vebt.intros(3) valid_member_both_member_options by blast
next
case (4 treeList n summary m deg mi ma)
hence 00:"deg = n + m ∧ length treeList = 2^n ∧ n = m ∧ n ≥ 1 ∧ deg ≥ 2"
by (metis One_nat_def Suc_leI add_mono_thms_linordered_semiring(1) deg_not_0 one_add_one)
hence xyprop: "high x n < 2^m ∧ high y n < 2^m"
by (metis "4.prems"(1) "4.prems"(2) high_def less_mult_imp_div_less mult_2 power2_eq_square power_even_eq)
have "low x n <2^n ∧ low y n< 2^n"
by (simp add: low_def)
hence "x = mi ∨ x = ma ∨ both_member_options (treeList ! (high x n)) (low x n)"
by (smt "00" "4.prems"(3) add_Suc_right add_self_div_2 both_member_options_def le_add_diff_inverse membermima.simps(4) naive_member.simps(3) plus_1_eq_Suc)
have 001:"invar_vebt (Node (Some (mi, ma)) deg treeList summary) deg" using invar_vebt.intros(4)[of treeList n summary m deg mi ma] "4" by simp
then show ?case
proof(cases "x = y")
case True
hence "both_member_options (vebt_insert (Node (Some (mi, ma)) deg treeList summary) y) y"
using 001 valid_insert_both_member_options_add[of "(Node (Some (mi, ma)) deg treeList summary)" deg y ]
using "4.prems"(2) by blast
then show ?thesis
by (simp add: True)
next
case False
then show ?thesis
proof(cases "y = mi ∨ y = ma")
case True
have "Suc (Suc (deg -2)) = deg"
using "00" by linarith
hence "vebt_insert (Node (Some (mi, ma)) deg treeList summary) y = Node (Some (mi, ma)) deg treeList summary"
using vebt_insert.simps(5)[of mi ma "deg-2" treeList summary x] 00 True insert_simp_mima by blast
then show ?thesis
by (simp add: "4.prems"(3))
next
case False
hence 0:"y ≠ mi ∧ y ≠ ma" by simp
then show ?thesis
proof(cases "x = mi")
case True
hence 1:"x = mi" by simp
then show ?thesis
proof(cases "x < y")
case True
have 14:"vebt_insert (Node (Some (mi,ma)) deg treeList summary) y =
Node (Some (x, max y ma)) deg (treeList [ (high y n):=vebt_insert (treeList ! (high y n)) (low y n)] )
(if minNull (treeList ! (high y n)) then vebt_insert summary (high y n) else summary)"
using "00" "1" False True insert_simp_norm xyprop by auto
then show ?thesis
by (metis "001" Suc_pred both_member_options_def deg_not_0 membermima.simps(4))
next
case False
have 14:"vebt_insert (Node (Some (mi,ma)) deg treeList summary) y =
Node (Some (y, max x ma)) deg (treeList [ (high x n) :=vebt_insert (treeList ! (high x n)) (low x n)])
(if minNull (treeList ! (high x n)) then vebt_insert summary (high x n) else summary)"
by (metis "0" "00" False True add_self_div_2 insert_simp_excp linorder_neqE_nat xyprop)
have 15: " invar_vebt (treeList ! (high x n)) n"
by (metis "4"(1) "4.hyps"(2) in_set_member inthall xyprop)
hence 16: "both_member_options (vebt_insert (treeList ! high x n) (low x n)) (low x n)"
using ‹low x n < 2 ^ n ∧ low y n < 2 ^ n› valid_insert_both_member_options_add by blast
then show ?thesis
by (metis "00" "14" Suc_1 add_leD1 add_self_div_2 both_member_options_from_chilf_to_complete_tree length_list_update nth_list_update_eq plus_1_eq_Suc xyprop)
qed
next
case False
hence "mi ≠ ma"
using "001" "4.prems"(3) less_irrefl member_inv valid_member_both_member_options by fastforce
hence "both_member_options (treeList !(high x n) ) (low x n) ∨ x = ma"
using False ‹x = mi ∨ x = ma ∨ both_member_options (treeList ! high x n) (low x n)› by blast
have "high ma n < 2^n"
by (metis "4.hyps"(3) "4.hyps"(4) "4.hyps"(8) high_def less_mult_imp_div_less mult_2 power2_eq_square power_even_eq)
hence "both_member_options (treeList !(high ma n) ) (low ma n)"
using "4.hyps"(3) "4.hyps"(9) ‹mi ≠ ma› by blast
hence "both_member_options (treeList !(high x n) ) (low x n)"
using ‹both_member_options (treeList ! high x n) (low x n) ∨ x = ma› by blast
then show ?thesis
proof(cases "mi < y")
case True
have 14:"vebt_insert (Node (Some (mi,ma)) deg treeList summary) y =
Node (Some (mi, max y ma)) deg (treeList[(high y n):=vebt_insert (treeList ! (high y n)) (low y n)])
(if minNull (treeList ! (high y n)) then vebt_insert summary (high y n) else summary)"
using "0" "00" True insert_simp_norm xyprop by auto
have "invar_vebt (treeList ! (high x n)) n"
by (metis "4.IH"(1) "4.hyps"(2) in_set_member inthall xyprop)
then show ?thesis
proof(cases "high x n = high y n")
case True
have "both_member_options (vebt_insert (treeList ! (high y n)) (low y n)) (low x n)"
using "4.IH"(1) "4.hyps"(2) True ‹both_member_options (treeList ! high x n) (low x n)› ‹low x n < 2 ^ n ∧ low y n < 2 ^ n› xyprop by auto
then show ?thesis
by (metis "00" "14" Suc_1 True add_leD1 add_self_div_2 both_member_options_from_chilf_to_complete_tree length_list_update nth_list_update_eq plus_1_eq_Suc xyprop)
next
case False
have "(treeList[ (high y n):=vebt_insert (treeList ! (high y n)) (low y n)]) ! (high x n) = treeList ! (high x n)"
using False by auto
then show ?thesis
by (metis "00" "14" One_nat_def Suc_leD ‹both_member_options (treeList ! high x n) (low x n)› add_self_div_2 both_member_options_from_chilf_to_complete_tree length_list_update numeral_2_eq_2 xyprop)
qed
next
case False
have 14:"vebt_insert (Node (Some (mi,ma)) deg treeList summary) y =
Node (Some (y, max mi ma)) deg (treeList[ (high mi n):=vebt_insert (treeList ! (high mi n)) (low mi n)])
(if minNull (treeList ! (high mi n)) then vebt_insert summary (high mi n) else summary)"
using insert_simp_excp[of mi deg treeList y ma summary]
by (smt "0" "00" "4.hyps"(7) "4.hyps"(8) False add_self_div_2 antisym_conv3 high_def le_less_trans less_mult_imp_div_less mult_2 power2_eq_square power_even_eq)
have mimaprop: "high mi n < 2^n ∧ low mi n < 2^n"
by (metis "00" "4.hyps"(7) "4.hyps"(8) Euclidean_Division.div_eq_0_iff div_exp_eq high_def le_less_trans low_def mod_less_divisor zero_less_numeral zero_less_power)
have "invar_vebt (treeList ! (high x n)) n"
by (metis "4.IH"(1) "4.hyps"(2) in_set_member inthall xyprop)
then show ?thesis
proof(cases "high x n = high mi n")
case True
have "both_member_options (vebt_insert (treeList ! (high mi n)) (low mi n)) (low x n)"
by (metis "4.IH"(1) "4.hyps"(2) True ‹both_member_options (treeList ! high x n) (low x n)› ‹low x n < 2 ^ n ∧ low y n < 2 ^ n› mimaprop nth_mem xyprop)
then show ?thesis
by (metis "00" "14" Suc_1 Suc_leD True add_self_div_2 both_member_options_from_chilf_to_complete_tree length_list_update nth_list_update_eq xyprop)
next
case False
have "(treeList[(high mi n):=vebt_insert (treeList ! (high mi n)) (low mi n)]) ! (high x n) = treeList ! (high x n)"
using False by force
then show ?thesis
by (metis "00" "14" One_nat_def Suc_leD ‹both_member_options (treeList ! high x n) (low x n)› add_self_div_2 both_member_options_from_chilf_to_complete_tree length_list_update numeral_2_eq_2 xyprop)
qed
qed
qed
qed
qed
next
case (5 treeList n summary m deg mi ma)
hence 00:"deg = n + m ∧ length treeList = 2^m ∧ Suc n = m ∧ n ≥ 1 ∧ deg ≥ 2 ∧ n = deg div 2"
by (metis Suc_1 add_Suc_right add_mono_thms_linordered_semiring(1) add_self_div_2 even_Suc_div_two le_add1 odd_add plus_1_eq_Suc set_n_deg_not_0)
hence xyprop: "high x n < 2^m ∧ high y n < 2^m"
by (metis "5.prems"(1) "5.prems"(2) Suc_1 div_exp_eq div_if high_def nat.discI power_not_zero)
have "low x n <2^n ∧ low y n< 2^n"
by (simp add: low_def)
hence "x = mi ∨ x = ma ∨ both_member_options (treeList ! (high x n)) (low x n)"
by (smt "00" "5.prems"(3) add_Suc_right add_self_div_2 both_member_options_def le_add_diff_inverse membermima.simps(4) naive_member.simps(3) plus_1_eq_Suc)
have 001:"invar_vebt (Node (Some (mi, ma)) deg treeList summary) deg"
using invar_vebt.intros(5)[of treeList n summary m deg mi ma] "5" by simp
then show ?case
proof(cases "x = y")
case True
hence "both_member_options (vebt_insert (Node (Some (mi, ma)) deg treeList summary) y) y"
using 001 valid_insert_both_member_options_add[of "(Node (Some (mi, ma)) deg treeList summary)" deg y ]
using "5.prems"(2) by blast
then show ?thesis
by (simp add: True)
next
case False
then show ?thesis
proof(cases "y = mi ∨ y = ma")
case True
have "Suc (Suc (deg -2)) = deg"
using "00" by linarith
hence "vebt_insert (Node (Some (mi, ma)) deg treeList summary) y = Node (Some (mi, ma)) deg treeList summary"
using vebt_insert.simps(5)[of mi ma "deg-2" treeList summary x] 00 True insert_simp_mima by blast
then show ?thesis
by (simp add: "5.prems"(3))
next
case False
hence 0:"y ≠ mi ∧ y ≠ ma" by simp
then show ?thesis
proof(cases "x = mi")
case True
hence 1:"x = mi" by simp
then show ?thesis
proof(cases "x < y")
case True
have 14:"vebt_insert (Node (Some (mi,ma)) deg treeList summary) y =
Node (Some (x, max y ma)) deg (treeList[ (high y n):=vebt_insert (treeList ! (high y n)) (low y n)] )
(if minNull (treeList ! (high y n)) then vebt_insert summary (high y n) else summary)"
using "00" "1" False True insert_simp_norm xyprop by metis
then show ?thesis
by (metis "001" Suc_pred both_member_options_def deg_not_0 membermima.simps(4))
next
case False
have 14:"vebt_insert (Node (Some (mi,ma)) deg treeList summary) y =
Node (Some (y, max x ma)) deg (treeList[ (high x n):=vebt_insert (treeList ! (high x n)) (low x n)])
(if minNull (treeList ! (high x n)) then vebt_insert summary (high x n) else summary)"
by (metis "0" "00" False True add_self_div_2 insert_simp_excp linorder_neqE_nat xyprop)
have 15: " invar_vebt (treeList ! (high x n)) n"
by (metis "5"(1) "5.hyps"(2) in_set_member inthall xyprop)
hence 16: "both_member_options (vebt_insert (treeList ! high x n) (low x n)) (low x n)"
using ‹low x n < 2 ^ n ∧ low y n < 2 ^ n› valid_insert_both_member_options_add by blast
then show ?thesis
by (metis "00" "14" Suc_1 add_leD1 both_member_options_from_chilf_to_complete_tree length_list_update nth_list_update_eq plus_1_eq_Suc xyprop)
qed
next
case False
hence "mi ≠ ma"
using "001" "5.prems"(3) less_irrefl member_inv valid_member_both_member_options by fastforce
hence "both_member_options (treeList !(high x n) ) (low x n) ∨ x = ma"
using False ‹x = mi ∨ x = ma ∨ both_member_options (treeList ! high x n) (low x n)› by blast
have "high ma n < 2^m"
by (metis "00" "5.hyps"(8) Euclidean_Division.div_eq_0_iff div_exp_eq high_def nat_zero_less_power_iff power_not_zero zero_power2)
hence "both_member_options (treeList !(high ma n) ) (low ma n)"
using "5.hyps"(3) "5.hyps"(9) ‹mi ≠ ma› by blast
hence "both_member_options (treeList !(high x n) ) (low x n)"
using ‹both_member_options (treeList ! high x n) (low x n) ∨ x = ma› by blast
then show ?thesis
proof(cases "mi < y")
case True
have 14:"vebt_insert (Node (Some (mi,ma)) deg treeList summary) y =
Node (Some (mi, max y ma)) deg (treeList[(high y n):= vebt_insert (treeList ! (high y n)) (low y n)])
(if minNull (treeList ! (high y n)) then vebt_insert summary (high y n) else summary)"
by (metis "0" "00" True insert_simp_norm xyprop)
have "invar_vebt (treeList ! (high x n)) n"
by (metis "5.IH"(1) "5.hyps"(2) in_set_member inthall xyprop)
then show ?thesis
proof(cases "high x n = high y n")
case True
have "both_member_options (vebt_insert (treeList ! (high y n)) (low y n)) (low x n)"
by (metis "5.IH"(1) "5.hyps"(2) True ‹both_member_options (treeList ! high x n) (low x n)› ‹low x n < 2 ^ n ∧ low y n < 2 ^ n› nth_mem xyprop)
then show ?thesis
by (metis "00" "14" Suc_1 True add_leD1 both_member_options_from_chilf_to_complete_tree length_list_update nth_list_update_eq plus_1_eq_Suc xyprop)
next
case False
have "(treeList[ (high y n):=vebt_insert (treeList ! (high y n)) (low y n)] ) ! (high x n) = treeList ! (high x n)"
using False by force
then show ?thesis
by (metis "00" "14" One_nat_def Suc_leD ‹both_member_options (treeList ! high x n) (low x n)› both_member_options_from_chilf_to_complete_tree length_list_update numeral_2_eq_2 xyprop)
qed
next
case False
have 14:"vebt_insert (Node (Some (mi,ma)) deg treeList summary) y =
Node (Some (y, max mi ma)) deg (treeList[(high mi n):= vebt_insert (treeList ! (high mi n)) (low mi n)] )
(if minNull (treeList ! (high mi n)) then vebt_insert summary (high mi n) else summary)"
using insert_simp_excp[of mi deg treeList y ma summary]
by (metis "0" "00" "5.hyps"(7) "5.hyps"(8) Euclidean_Division.div_eq_0_iff False antisym_conv3 div_exp_eq high_def le_less_trans power_not_zero zero_neq_numeral)
have mimaprop: "high mi n < 2^m ∧ low mi n < 2^n" using exp_split_high_low[of mi n m] 00 "5"(9,10) by force
have "invar_vebt (treeList ! (high x n)) n"
by (metis "5.IH"(1) "5.hyps"(2) in_set_member inthall xyprop)
then show ?thesis
proof(cases "high x n = high mi n")
case True
have "both_member_options (vebt_insert (treeList ! (high mi n)) (low mi n)) (low x n)"
by (metis "5.IH"(1) "5.hyps"(2) True ‹both_member_options (treeList ! high x n) (low x n)› ‹low x n < 2 ^ n ∧ low y n < 2 ^ n› mimaprop nth_mem)
then show ?thesis
by (metis "00" "14" Suc_1 True add_leD1 both_member_options_from_chilf_to_complete_tree length_list_update nth_list_update_eq plus_1_eq_Suc xyprop)
next
case False
have "(treeList[ (high mi n):=vebt_insert (treeList ! (high mi n)) (low mi n)]) ! (high x n) = treeList ! (high x n)"
by (metis False nth_list_update_neq)
then show ?thesis
by (metis "00" "14" One_nat_def Suc_leD ‹both_member_options (treeList ! high x n) (low x n)› both_member_options_from_chilf_to_complete_tree length_list_update numeral_2_eq_2 xyprop)
qed
qed
qed
qed
qed
qed
lemma post_member_pre_member:"invar_vebt t n ⟹ x< 2^n ⟹ y <2^n ⟹ vebt_member (vebt_insert t x) y ⟹ vebt_member t y ∨ x = y"
proof(induction t n arbitrary: x y rule: invar_vebt.induct)
case (1 a b) then show ?case by auto
next
case (2 treeList n summary m deg)
hence "deg ≥ 2"
using deg_not_0 by fastforce
then show ?case using vebt_insert.simps(4)[of "deg-2" treeList summary x]
by (metis (no_types, lifting) "2.prems"(3) vebt_member.simps(5) add_numeral_left le_add_diff_inverse member_inv numerals(1) plus_1_eq_Suc semiring_norm(2))
next
case (3 treeList n summary m deg)
hence "deg ≥ 2"
by (metis vebt_member.simps(2) One_nat_def Suc_1 Suc_eq_plus1 add_mono_thms_linordered_semiring(1) vebt_insert.simps(3) le_Suc_eq le_add1 plus_1_eq_Suc)
then show ?case using vebt_insert.simps(4)[of "deg-2" treeList summary x]
by (metis (no_types, lifting) "3.prems"(3) vebt_member.simps(5) add_numeral_left le_add_diff_inverse member_inv numerals(1) plus_1_eq_Suc semiring_norm(2))
next
case (4 treeList n summary m deg mi ma)
hence 00:"deg = n+m ∧ n ≥ 0 ∧ n = m ∧ deg ≥ 2 ∧ length treeList =2^n"
by (metis Euclidean_Division.div_eq_0_iff add_self_div_2 deg_not_0 not_less zero_le)
hence xyprop: "high x n < 2^n ∧ high y n < 2^n"
using "4.hyps"(1) "4.prems"(1) "4.prems"(2) deg_not_0 exp_split_high_low(1) by blast
have "low x n <2^n ∧ low y n< 2^n"
by (simp add: low_def)
then show ?case
proof(cases "x = mi ∨ x = ma")
case True
then show ?thesis
using "00" "4.prems"(3) insert_simp_mima by auto
next
case False
hence mimaxyprop: "¬ (x = mi ∨ x = ma) ∧ high x n < 2^n ∧ high mi n < 2^n ∧ low x n <2^n ∧ low mi n < 2^n ∧ length treeList = 2^n"
using "00" "4.hyps"(1) "4.hyps"(7) "4.hyps"(8) ‹low x n < 2 ^ n ∧ low y n < 2 ^ n› deg_not_0 exp_split_high_low(1) exp_split_high_low(2) le_less_trans xyprop by blast
then show ?thesis
proof(cases "mi < x")
case True
hence "vebt_insert (Node (Some (mi,ma)) deg treeList summary) x =
Node (Some (mi, max x ma)) deg (treeList[(high x n) :=vebt_insert (treeList ! (high x n)) (low x n)])
(if minNull (treeList ! (high x n)) then vebt_insert summary (high x n) else summary)"
using insert_simp_norm[of x n treeList mi ma summary] mimaxyprop "00" add_self_div_2 insert_simp_norm by metis
then show ?thesis
proof(cases "y = mi ∨ y = max x ma")
case True
then show ?thesis
proof(cases "y = mi")
case True
then show ?thesis
by (metis "00" vebt_member.simps(5) le0 not_less_eq_eq numeral_2_eq_2 old.nat.exhaust)
next
case False
hence "y = max x ma"
using True by blast
then show ?thesis
proof(cases "x < ma")
case True
then show ?thesis
by (metis (no_types, lifting) "00" vebt_member.simps(5) ‹y = max x ma› add_numeral_left le_add_diff_inverse max_less_iff_conj not_less_iff_gr_or_eq numerals(1) plus_1_eq_Suc semiring_norm(2))
next
case False
then show ?thesis
using ‹y = max x ma› by linarith
qed
qed
next
case False
hence "vebt_member ((treeList[(high x n):= vebt_insert (treeList ! (high x n)) (low x n)]) ! (high y n)) (low y n)"
by (metis "4.hyps"(3) "4.hyps"(4) "4.prems"(3) ‹vebt_insert (Node (Some (mi, ma)) deg treeList summary) x = Node (Some (mi, max x ma)) deg (treeList[high x n := vebt_insert (treeList ! high x n) (low x n)]) (if minNull (treeList ! high x n) then vebt_insert summary (high x n) else summary)› add_self_div_2 member_inv)
then show ?thesis
proof(cases "high x n = high y n")
case True
hence 000:"vebt_member (vebt_insert (treeList ! (high x n)) (low x n)) (low y n)"
using ‹vebt_member (treeList[high x n := vebt_insert (treeList ! high x n) (low x n)] ! high y n) (low y n)› mimaxyprop by auto
have 001:"invar_vebt (treeList ! (high x n)) n ∧ treeList ! (high x n) ∈ set treeList "
by (simp add: "4.IH"(1) mimaxyprop)
hence 002:"vebt_member (treeList ! (high x n)) (low y n) ∨ low y n = low x n"
using "000" "4.IH"(1) ‹low x n < 2 ^ n ∧ low y n < 2 ^ n› by fastforce
hence 003:"both_member_options (treeList ! (high x n)) (low y n) ∨ low y n = low x n"
using ‹invar_vebt (treeList ! high x n) n ∧ treeList ! high x n ∈ set treeList› both_member_options_equiv_member by blast
have 004:"naive_member (treeList ! (high x n)) (low y n) ⟹
naive_member (Node (Some (mi , ma)) deg treeList summary) y"
by (metis "00" Suc_le_D True add_self_div_2 mimaxyprop naive_member.simps(3) one_add_one plus_1_eq_Suc)
hence 005:"both_member_options (Node (Some (mi , ma)) deg treeList summary) y ∨ x = y"
by (metis "00" "001" "002" Suc_le_D True add_self_div_2 bit_split_inv both_member_options_def member_valid_both_member_options membermima.simps(4) mimaxyprop one_add_one plus_1_eq_Suc)
then show ?thesis
by (smt "00" "001" "002" "003" "4"(11) "4"(8) vebt_member.simps(5) True add_numeral_left add_self_div_2 bit_split_inv le_add_diff_inverse mimaxyprop not_less not_less_iff_gr_or_eq numerals(1) plus_1_eq_Suc semiring_norm(2))
next
case False
hence 000:"vebt_member (treeList ! (high y n)) (low y n)"
using ‹vebt_member (treeList[high x n := vebt_insert (treeList ! high x n) (low x n)] ! high y n) (low y n)› by auto
moreover have 004:"naive_member (treeList ! (high y n)) (low y n) ⟹
naive_member (Node (Some (mi , ma)) deg treeList summary) y"
by (metis "00" Suc_le_D add_self_div_2 naive_member.simps(3) one_add_one plus_1_eq_Suc xyprop)
moreover have 001:"invar_vebt (treeList ! (high y n)) n ∧ treeList ! (high y n) ∈ set treeList "
by (metis (full_types) "4.IH"(1) "4.hyps"(2) "4.hyps"(3) inthall member_def xyprop)
moreover have " both_member_options (Node (Some (mi , ma)) deg treeList summary) y"
by (metis "00" "000" "001" "004" Suc_le_D add_self_div_2 both_member_options_def member_valid_both_member_options membermima.simps(4) one_add_one plus_1_eq_Suc xyprop)
moreover have "vebt_member (Node (Some (mi, ma)) deg treeList summary) y"
using both_member_options_equiv_member[of "(Node (Some (mi, ma)) deg treeList summary)" deg y]
invar_vebt.intros(4)[of treeList n summary m deg mi ma]
using "4" calculation(4) by blast
then show ?thesis by simp
qed
qed
next
case False
hence "x < mi"
using mimaxyprop nat_neq_iff by blast
hence "vebt_insert (Node (Some (mi,ma)) deg treeList summary) x =
Node (Some (x, max mi ma)) deg (treeList[ (high mi n):=vebt_insert (treeList ! (high mi n)) (low mi n)])
(if minNull (treeList ! (high mi n)) then vebt_insert summary (high mi n) else summary)"
using insert_simp_excp[of mi n treeList x ma summary] mimaxyprop "00" add_self_div_2 insert_simp_excp by metis
then show ?thesis
proof(cases "y = x ∨ y = max mi ma")
case True
then show ?thesis
proof(cases "y = x")
case True
then show ?thesis
by (simp add: "00")
next
case False
hence "y = max mi ma"
using True by blast
then show ?thesis
proof(cases "mi < ma")
case True
then show ?thesis using "00" vebt_member.simps(5) ‹y = max mi ma› add_numeral_left
le_add_diff_inverse max_less_iff_conj not_less_iff_gr_or_eq numerals(1) plus_1_eq_Suc semiring_norm(2)
by (metis (no_types, lifting))
next
case False
then show ?thesis
by (metis "00" "4.hyps"(7) vebt_member.simps(5) ‹y = max mi ma› add_numeral_left le_add_diff_inverse max.absorb2 numerals(1) plus_1_eq_Suc semiring_norm(2))
qed
qed
next
case False
hence "vebt_member ((treeList[(high mi n) :=vebt_insert (treeList ! (high mi n)) (low mi n)]) ! (high y n)) (low y n)"
by (metis "4.hyps"(3) "4.hyps"(4) "4.prems"(3) ‹vebt_insert (Node (Some (mi, ma)) deg treeList summary) x = Node (Some (x, max mi ma)) deg (treeList[high mi n := vebt_insert (treeList ! high mi n) (low mi n)]) (if minNull (treeList ! high mi n) then vebt_insert summary (high mi n) else summary)› add_self_div_2 member_inv)
then show ?thesis
proof(cases "high mi n = high y n")
case True
hence 000:"vebt_member (vebt_insert (treeList ! (high mi n)) (low mi n)) (low y n)"
by (metis ‹vebt_member (treeList[high mi n := vebt_insert (treeList ! high mi n) (low mi n)] ! high y n) (low y n)› mimaxyprop nth_list_update_eq)
have 001:"invar_vebt (treeList ! (high mi n)) n ∧ treeList ! (high mi n) ∈ set treeList"
by (simp add: "4.IH"(1) mimaxyprop)
hence 002:"vebt_member (treeList ! (high mi n)) (low y n) ∨ low y n = low mi n"
using "000" "4.IH"(1) ‹low x n < 2 ^ n ∧ low y n < 2 ^ n› mimaxyprop by fastforce
hence 003:"both_member_options (treeList ! (high mi n)) (low y n) ∨ low y n = low mi n"
using ‹invar_vebt (treeList ! high mi n) n ∧ treeList ! high mi n ∈ set treeList› both_member_options_equiv_member by blast
have 004:"naive_member (treeList ! (high mi n)) (low y n) ⟹
naive_member (Node (Some (mi , ma)) deg treeList summary) y" using naive_member.simps(3)[of "Some (mi, ma)" "deg-1" treeList summary y]
using "00" True mimaxyprop by fastforce
hence 005:"both_member_options (Node (Some (mi , ma)) deg treeList summary) y ∨ x = y"
by (metis "00" "001" "002" Suc_le_D True add_self_div_2 bit_split_inv both_member_options_def member_valid_both_member_options membermima.simps(4) mimaxyprop one_add_one plus_1_eq_Suc)
then show ?thesis
by (smt "00" "001" "002" "003" "4.hyps"(6) "4.hyps"(9) vebt_member.simps(5) True add_numeral_left add_self_div_2 bit_split_inv le_add_diff_inverse mimaxyprop not_less not_less_iff_gr_or_eq numerals(1) plus_1_eq_Suc semiring_norm(2))
next
case False
hence 000:"vebt_member (treeList ! (high y n)) (low y n)"
using ‹vebt_member (treeList[high mi n := vebt_insert (treeList ! high mi n) (low mi n)] ! high y n) (low y n)› by auto
moreover have 004:"naive_member (treeList ! (high y n)) (low y n) ⟹
naive_member (Node (Some (mi , ma)) deg treeList summary) y"
by (metis "00" Suc_le_D add_self_div_2 naive_member.simps(3) one_add_one plus_1_eq_Suc xyprop)
moreover have 001:"invar_vebt (treeList ! (high y n)) n ∧ treeList ! (high y n) ∈ set treeList "
by (metis (full_types) "4.IH"(1) "4.hyps"(2) "4.hyps"(3) inthall member_def xyprop)
moreover have " both_member_options (Node (Some (mi , ma)) deg treeList summary) y"
by (metis "00" "000" "001" "004" Suc_le_D add_self_div_2 both_member_options_def member_valid_both_member_options membermima.simps(4) one_add_one plus_1_eq_Suc xyprop)
then show ?thesis using both_member_options_equiv_member[of "(Node (Some (mi, ma)) deg treeList summary)" deg y]
invar_vebt.intros(4)[of treeList n summary m deg mi ma] "4" by blast
qed
qed
qed
qed
next
case (5 treeList n summary m deg mi ma)
hence 00:"deg = n+m ∧ n ≥ 0 ∧ Suc n = m ∧ deg ≥ 2 ∧ length treeList =2^m ∧ n ≥ 1"
by (metis Suc_1 add_mono_thms_linordered_semiring(1) le_add1 plus_1_eq_Suc set_n_deg_not_0 zero_le)
hence xyprop: "high x n < 2^m ∧ high y n < 2^m"
using "5.prems"(1) "5.prems"(2) exp_split_high_low(1) by auto
have "low x n <2^n ∧ low y n< 2^n"
by (simp add: low_def)
then show ?case
proof(cases "x = mi ∨ x = ma")
case True
then show ?thesis
using "00" "5.prems"(3) insert_simp_mima by auto
next
case False
hence mimaxyprop: "¬ (x = mi ∨ x = ma) ∧ high x n < 2^m ∧ high mi n < 2^m ∧ low x n <2^n ∧ low mi n < 2^n ∧ length treeList = 2^m"
using "00" "5" ‹low x n < 2 ^ n ∧ low y n < 2 ^ n› deg_not_0 exp_split_high_low(1) exp_split_high_low(2) le_less_trans xyprop
by (smt less_le_trans less_numeral_extra(1))
then show ?thesis
proof(cases "mi < x")
case True
hence "vebt_insert (Node (Some (mi,ma)) deg treeList summary) x =
Node (Some (mi, max x ma)) deg (treeList[ (high x n):=vebt_insert (treeList ! (high x n)) (low x n)])
(if minNull (treeList ! (high x n)) then vebt_insert summary (high x n) else summary)"
using insert_simp_norm[of x deg treeList mi ma summary]
by (smt "00" False add_Suc_right add_self_div_2 even_Suc_div_two odd_add xyprop)
then show ?thesis
proof(cases "y = mi ∨ y = max x ma")
case True
then show ?thesis
proof(cases "y = mi")
case True
then show ?thesis
by (metis "00" vebt_member.simps(5) le0 not_less_eq_eq numeral_2_eq_2 old.nat.exhaust)
next
case False
hence "y = max x ma"
using True by blast
then show ?thesis
proof(cases "x < ma")
case True
then show ?thesis
by (metis (no_types, lifting) "00" vebt_member.simps(5) ‹y = max x ma› add_numeral_left le_add_diff_inverse max_less_iff_conj not_less_iff_gr_or_eq numerals(1) plus_1_eq_Suc semiring_norm(2))
next
case False
then show ?thesis
using ‹y = max x ma› by linarith
qed
qed
next
case False
hence "vebt_member ((treeList[ (high x n):=vebt_insert (treeList ! (high x n)) (low x n)]) ! (high y n)) (low y n)"
using "5.hyps"(3) "5.hyps"(4) "5.prems"(3) ‹vebt_insert (Node (Some (mi, ma)) deg treeList summary) x = Node (Some (mi, max x ma)) deg (treeList[high x n := vebt_insert (treeList ! high x n) (low x n)]) (if minNull (treeList ! high x n) then vebt_insert summary (high x n) else summary)› add_Suc_right add_self_div_2 member_inv by force
then show ?thesis
proof(cases "high x n = high y n")
case True
hence 000:"vebt_member (vebt_insert (treeList ! (high x n)) (low x n)) (low y n)"
by (metis "5.hyps"(2) ‹vebt_member (treeList[high x n := vebt_insert (treeList ! high x n) (low x n)] ! high y n) (low y n)› nth_list_update_eq xyprop)
have 001:"invar_vebt (treeList ! (high x n)) n ∧ treeList ! (high x n) ∈ set treeList "
by (simp add: "5.IH"(1) "5.hyps"(2) xyprop)
hence 002:"vebt_member (treeList ! (high x n)) (low y n) ∨ low y n = low x n"
using "000" "5.IH"(1) ‹low x n < 2 ^ n ∧ low y n < 2 ^ n› by fastforce
hence 003:"both_member_options (treeList ! (high x n)) (low y n) ∨ low y n = low x n"
using ‹invar_vebt (treeList ! high x n) n ∧ treeList ! high x n ∈ set treeList› both_member_options_equiv_member by blast
have 004:"naive_member (treeList ! (high x n)) (low y n) ⟹
naive_member (Node (Some (mi , ma)) deg treeList summary) y"
using "00" True xyprop by auto
hence 005:"both_member_options (Node (Some (mi , ma)) deg treeList summary) y ∨ x = y"
by (smt "00" "001" "002" True add_Suc_right add_self_div_2 bit_split_inv both_member_options_def even_Suc_div_two member_valid_both_member_options membermima.simps(4) odd_add xyprop)
then show ?thesis
using both_member_options_equiv_member[of "(Node (Some (mi, ma)) deg treeList summary)" deg y]
invar_vebt.intros(5)[of treeList n summary m deg mi ma] "5" by blast
next
case False
hence 000:"vebt_member (treeList ! (high y n)) (low y n)"
using ‹vebt_member (treeList[high x n := vebt_insert (treeList ! high x n) (low x n)] ! high y n) (low y n)› by fastforce
moreover have 004:"naive_member (treeList ! (high y n)) (low y n) ⟹
naive_member (Node (Some (mi , ma)) deg treeList summary) y"
using "00" xyprop by auto
moreover have 001:"invar_vebt (treeList ! (high y n)) n ∧ treeList ! (high y n) ∈ set treeList "
by (metis (full_types) "5"inthall member_def xyprop)
moreover have " both_member_options (Node (Some (mi , ma)) deg treeList summary) y"
using "00" "000" "001" both_member_options_def member_valid_both_member_options xyprop by fastforce
moreover have "vebt_member (Node (Some (mi, ma)) deg treeList summary) y"
using both_member_options_equiv_member[of "(Node (Some (mi, ma)) deg treeList summary)" deg y]
invar_vebt.intros(5)[of treeList n summary m deg mi ma] "5" calculation(4) by blast
then show ?thesis by simp
qed
qed
next
case False
hence "x < mi"
using mimaxyprop nat_neq_iff by blast
hence "vebt_insert (Node (Some (mi,ma)) deg treeList summary) x =
Node (Some (x, max mi ma)) deg (treeList[ (high mi n):=vebt_insert (treeList ! (high mi n)) (low mi n)])
(if minNull (treeList ! (high mi n)) then vebt_insert summary (high mi n) else summary)"
using insert_simp_excp[of mi n treeList x ma summary] mimaxyprop "00" add_self_div_2 insert_simp_excp
by (smt add_Suc_right even_Suc_div_two odd_add)
then show ?thesis
proof(cases "y = x ∨ y = max mi ma")
case True
then show ?thesis
proof(cases "y = x")
case True
then show ?thesis
by (simp add: "00")
next
case False
hence "y = max mi ma"
using True by blast
then show ?thesis
proof(cases "mi < ma")
case True
then show ?thesis using "00" vebt_member.simps(5) ‹y = max mi ma› add_numeral_left
le_add_diff_inverse max_less_iff_conj not_less_iff_gr_or_eq numerals(1) plus_1_eq_Suc semiring_norm(2)
by (metis (no_types, lifting))
next
case False
then show ?thesis
by (metis "00" "5.hyps"(7) vebt_member.simps(5) ‹y = max mi ma› add_numeral_left le_add_diff_inverse max.absorb2 numerals(1) plus_1_eq_Suc semiring_norm(2))
qed
qed
next
case False
hence "vebt_member ((treeList[(high mi n):=vebt_insert (treeList ! (high mi n)) (low mi n)]) ! (high y n)) (low y n)"
using "5.hyps"(3) "5.hyps"(4) "5.prems"(3) ‹vebt_insert (Node (Some (mi, ma)) deg treeList summary) x = Node (Some (x, max mi ma)) deg (treeList[high mi n := vebt_insert (treeList ! high mi n) (low mi n)]) (if minNull (treeList ! high mi n) then vebt_insert summary (high mi n) else summary)› member_inv by force
then show ?thesis
proof(cases "high mi n = high y n")
case True
hence 000:"vebt_member (vebt_insert (treeList ! (high mi n)) (low mi n)) (low y n)"
by (metis ‹vebt_member (treeList[high mi n := vebt_insert (treeList ! high mi n) (low mi n)] ! high y n) (low y n)› mimaxyprop nth_list_update_eq)
have 001:"invar_vebt (treeList ! (high mi n)) n ∧ treeList ! (high mi n) ∈ set treeList "
by (simp add: "5.IH"(1) mimaxyprop)
hence 002:"vebt_member (treeList ! (high mi n)) (low y n) ∨ low y n = low mi n"
using "000" "5.IH"(1) ‹low x n < 2 ^ n ∧ low y n < 2 ^ n› mimaxyprop by fastforce
hence 003:"both_member_options (treeList ! (high mi n)) (low y n) ∨ low y n = low mi n"
using ‹invar_vebt (treeList ! high mi n) n ∧ treeList ! high mi n ∈ set treeList› both_member_options_equiv_member by blast
have 004:"naive_member (treeList ! (high mi n)) (low y n) ⟹
naive_member (Node (Some (mi , ma)) deg treeList summary) y" using naive_member.simps(3)[of "Some (mi, ma)" "deg-1" treeList summary y]
using "00" True mimaxyprop by fastforce
hence 005:"both_member_options (Node (Some (mi , ma)) deg treeList summary) y ∨ x = y"
by (smt "00" "001" "002" True add_Suc_right add_self_div_2 bit_split_inv both_member_options_def even_Suc_div_two member_valid_both_member_options membermima.simps(4) odd_add xyprop)
then show ?thesis using "00" "001" "002" "003" "5"(14) "5.hyps"(6) "5.hyps"(7) "5.hyps"(9) vebt_member.simps(5) True
add_Suc_right add_self_div_2 bit_split_inv even_Suc_div_two le_add_diff_inverse max.absorb2
mimaxyprop not_less_iff_gr_or_eq odd_add plus_1_eq_Suc
by (smt (z3) ‹vebt_insert (Node (Some (mi, ma)) deg treeList summary) x = Node (Some (x, max mi ma)) deg (treeList[high mi n := vebt_insert (treeList ! high mi n) (low mi n)]) (if minNull (treeList ! high mi n) then vebt_insert summary (high mi n) else summary)›)
next
case False
hence 000:"vebt_member (treeList ! (high y n)) (low y n)"
using ‹vebt_member (treeList[high mi n := vebt_insert (treeList ! high mi n) (low mi n)] ! high y n) (low y n)› by auto
moreover have 004:"naive_member (treeList ! (high y n)) (low y n) ⟹
naive_member (Node (Some (mi , ma)) deg treeList summary) y"
using "00" xyprop by auto
moreover have 001:"invar_vebt (treeList ! (high y n)) n ∧ treeList ! (high y n) ∈ set treeList "
by (metis (full_types) "5.IH"(1) "5.hyps"(2) "5.hyps"(3) inthall member_def xyprop)
moreover have " both_member_options (Node (Some (mi , ma)) deg treeList summary) y"
using "00" "000" "001" both_member_options_def member_valid_both_member_options xyprop by fastforce
then show ?thesis using both_member_options_equiv_member[of "(Node (Some (mi, ma)) deg treeList summary)" deg y]
invar_vebt.intros(5)[of treeList n summary m deg mi ma] "5" by simp
qed
qed
qed
qed
qed
end
end
Theory VEBT_InsertCorrectness
theory VEBT_InsertCorrectness imports VEBT_Member VEBT_Insert
begin
context VEBT_internal begin
section ‹Correctness of the Insert Operation›
subsection ‹Validness Preservation›
theorem valid_pres_insert: "invar_vebt t n ⟹ x< 2^n ⟹ invar_vebt (vebt_insert t x) n"
proof(induction t n arbitrary: x rule: invar_vebt.induct)
case (1 a b)
then show ?case using vebt_insert.simps(1)[of a b x]
by (simp add: invar_vebt.intros(1))
next
case (2 treeList n summary m deg)
hence 0: " ( ∀ t ∈ set treeList. invar_vebt t n) " and 1:" invar_vebt summary n" and 2:" length treeList = 2^n" and
3:" deg = 2*n" and 4:" (∄ i. both_member_options summary i)" and 5:" (∀ t ∈ set treeList. ∄ x. both_member_options t x) " and 6: "n≥ 1"
using "2.prems" by (auto simp add: Suc_leI deg_not_0)
let ?t = "Node None deg treeList summary"
let ?tnew = "vebt_insert ?t x"
have 6:"?tnew = (Node (Some (x,x)) deg treeList summary)" using vebt_insert.simps(4)[of "deg-2" treeList summary x]
by (metis "1" "2.hyps"(3) "2.hyps"(4) add_2_eq_Suc add_diff_inverse_nat add_self_div_2 deg_not_0 div_less gr_implies_not0)
have 7:"(x = x ⟶ (∀ t ∈ set treeList. ∄ x. both_member_options t x))"
using ‹∀t∈set treeList. ∄x. both_member_options t x› by blast
have 8:"x ≤ x" by simp
have 9:" x < 2^deg"
by (simp add: "2.prems")
have 10:"(x ≠ x ⟶ (∀ i < 2^(2^n). (high x deg = i ⟶ both_member_options (treeList ! i) (low x deg)) ∧
(∀ y. (high y deg = i ∧ both_member_options (treeList ! i) (low y deg) ) ⟶ x < y ∧ y ≤ x) ))"
by simp
then show ?case using 0 1 2 3 4 5 6 7 8 9 10 invar_vebt.intros(4)[of treeList n summary m deg x x]
by (metis "2.hyps"(3) "2.hyps"(4) nth_mem)
next
case (3 treeList n summary m deg)
hence 0: " ( ∀ t ∈ set treeList. invar_vebt t n) " and 1:" invar_vebt summary m" and 2:" length treeList = 2^m" and
3:" deg = n+m" and 4:" (∄ i. both_member_options summary i)" and 5:" (∀ t ∈ set treeList. ∄ x. both_member_options t x) " and 6: "n≥ 1"
and 7: "Suc n = m" using "3.prems" apply auto
by (metis "3.hyps"(2) One_nat_def set_n_deg_not_0)
let ?t = "Node None deg treeList summary"
let ?tnew = "vebt_insert ?t x"
have 6:"?tnew = (Node (Some (x,x)) deg treeList summary)" using vebt_insert.simps(4)[of "deg-2" treeList summary x]
by (smt "3" "3.hyps"(3) "6" Nat.add_diff_assoc One_nat_def Suc_le_mono add_diff_inverse_nat add_gr_0 add_numeral_left diff_is_0_eq' not_less not_less_iff_gr_or_eq numeral_2_eq_2 numerals(1) plus_1_eq_Suc semiring_norm(2))
have 7:"(x = x ⟶ (∀ t ∈ set treeList. ∄ x. both_member_options t x))"
using ‹∀t∈set treeList. ∄x. both_member_options t x› by blast
have 8:"x ≤ x" by simp
have 9:" x < 2^deg"
by (simp add: "3.prems")
have 10:"(x ≠ x ⟶ (∀ i < 2^(2^n). (high x deg = i ⟶ both_member_options (treeList ! i) (low x deg)) ∧
(∀ y. (high y deg = i ∧ both_member_options (treeList ! i) (low y deg) ) ⟶ x < y ∧ y ≤ x) ))"
by simp
then show ?case using 0 1 2 3 4 5 6 7 8 9 10 invar_vebt.intros(5)[of treeList n summary m deg x x] "3.hyps"(3) nth_mem by force
next
case (4 treeList n summary m deg mi ma)
hence myIHs: "x ∈ set treeList ⟹ invar_vebt x n ⟹ xa < 2 ^ n ⟹ invar_vebt (vebt_insert x xa) n" for x xa by simp
hence 0: "( ∀ t ∈ set treeList. invar_vebt t n)" and 1: " invar_vebt summary m" and 2:"length treeList = 2^m" and 3:" deg = n+m" and
4: "(∀ i < 2^m. (∃ y. both_member_options (treeList ! i) y) ⟷ ( both_member_options summary i))" and
5: "(mi = ma ⟶ (∀ t ∈ set treeList. ∄ y. both_member_options t y))" and 6:"mi ≤ ma ∧ ma < 2^deg" and
7: "(mi ≠ ma ⟶ (∀ i < 2^m. (high ma n = i ⟶ both_member_options (treeList ! i) (low ma n)) ∧
(∀ y. (high y n = i ∧ both_member_options (treeList ! i) (low y n) ) ⟶ mi < y ∧ y ≤ ma)))"
and 8: "n = m" and 9: "deg div 2 = n" using "4" add_self_div_2 by blast+
then show ?case
proof(cases "x = mi ∨ x = ma")
case True
then show ?thesis using insert_simp_mima[of x mi ma deg treeList summary]
invar_vebt.intros(4)[of treeList n summary m deg mi ma]
by (smt "0" "1" "2" "3" "4" "4.hyps"(3) "4.hyps"(7) "4.hyps"(8) "5" "7" "9" deg_not_0 div_greater_zero_iff)
next
case False
hence mimaxrel: "x ≠ mi ∧ x ≠ ma" by simp
then show ?thesis
proof(cases "mi < x")
case True
hence abcdef: "mi < x" by simp
let ?h = "high x n" and ?l="low x n"
have highlowprop: "high x n < 2^m ∧ low x n < 2^n"
using "1" "3" "4.hyps"(3) "4.prems" deg_not_0 exp_split_high_low(1) exp_split_high_low(2) by blast
have 10:"vebt_insert (Node (Some (mi,ma)) deg treeList summary) x =
Node (Some (mi, max x ma)) deg (treeList[?h:=vebt_insert (treeList ! ?h) ?l])
(if minNull (treeList ! ?h) then vebt_insert summary ?h else summary) "
using "2" "3" False True ‹high x n < 2 ^ m ∧ low x n < 2 ^ n› insert_simp_norm by (metis "1" "4.hyps"(3) "9" deg_not_0 div_greater_zero_iff)
let ?maxnew = "max x ma" and ?nextTreeList = "(take ?h treeList @ [vebt_insert (treeList ! ?h) ?l] @ drop (?h+1) treeList)" and
?nextSummary = "(if minNull (treeList ! ?h) then vebt_insert summary ?h else summary)"
have 11: "( ∀ t ∈ set ?nextTreeList. invar_vebt t n)" proof
fix t
assume " t ∈ set ?nextTreeList"
hence 111:"t ∈ set (take ?h treeList) ∨ t ∈ set ([vebt_insert (treeList ! ?h) ?l] @ drop (?h+1) treeList)" by auto
show "invar_vebt t n"
proof(cases "t ∈ set (take ?h treeList) ")
case True
then show ?thesis
by (meson "0" in_set_takeD)
next
case False
hence 1110: "t = vebt_insert (treeList ! ?h) ?l ∨ t ∈ set ( drop (?h+1) treeList)"
using "111" by auto
then show ?thesis
proof(cases "t = vebt_insert (treeList ! ?h) ?l")
case True
have 11110: "invar_vebt (treeList ! ?h) n"
by (simp add: "2" "4.IH"(1) highlowprop)
have 11111: "?l < 2^n"
by (simp add: low_def)
then show ?thesis using myIHs[of "treeList ! ?h"]
by (simp add: "11110" "2" True highlowprop)
next
case False
then show ?thesis
by (metis "0" "1110" append_assoc append_take_drop_id in_set_conv_decomp)
qed
qed
qed
have 12: "invar_vebt ?nextSummary n"
proof(cases "minNull (treeList ! high x n)")
case True
then show ?thesis
using "4.IH"(2) "8" highlowprop by auto
next
case False
then show ?thesis
by (simp add: "1" "8")
qed
have 13: "∀ i < 2^m. (∃ y. both_member_options (?nextTreeList ! i) y) ⟷ ( both_member_options ?nextSummary i)"
proof
fix i
show "i < 2 ^ m ⟶ (∃y. both_member_options ((?nextTreeList) ! i) y) = both_member_options (?nextSummary) i "
proof
assume "i< 2^m"
show "(∃y. both_member_options ((?nextTreeList) ! i) y) = both_member_options (?nextSummary) i "
proof(cases "minNull (treeList ! high x n)")
case True
hence tc: "minNull (treeList ! high x n)" by simp
hence nsprop: "?nextSummary = vebt_insert summary ?h" by simp
have insprop:"?nextTreeList ! ?h = vebt_insert (treeList ! ?h) ?l"
by (metis "2" Suc_eq_plus1 append_Cons highlowprop nth_list_update_eq self_append_conv2 upd_conv_take_nth_drop)
then show ?thesis
proof(cases "i = ?h")
case True
have 161:"∄ y. vebt_member (treeList ! ?h) y"
by (simp add: min_Null_member tc)
hence 162:"∄ y. both_member_options (treeList ! ?h) y"
by (metis "2" "4.IH"(1) highlowprop nth_mem valid_member_both_member_options)
hence 163:"¬ both_member_options summary i"
using "11" "2" "4" True ‹i < 2 ^ m› by blast
have 164:"?nextTreeList ! i = vebt_insert (treeList ! ?h) ?l"
using True insprop by simp
have 165:"invar_vebt (vebt_insert (treeList ! ?h) ?l) n"
by (simp add: "11")
have 166:"both_member_options (vebt_insert (treeList ! ?h) ?l) ?l" using myIHs[of "treeList ! ?h" ?l]
by (metis "0" "2" highlowprop nth_mem valid_insert_both_member_options_add)
have 167:"∃ y. both_member_options ((?nextTreeList) ! i) y "
using "164" "166" by auto
then show ?thesis
using "1" "11" "2" True nsprop valid_insert_both_member_options_add highlowprop by auto
next
case False
have "?nextTreeList ! i = treeList ! i"
by (metis "2" False ‹i < 2 ^ m› highlowprop nth_repl)
have fstprop:"both_member_options ((?nextTreeList) ! i) y ⟹ both_member_options (?nextSummary) i " for y
using "1" "4" ‹(take (high x n) treeList @ [VEBT_Insert.vebt_insert (treeList ! high x n) (low x n)] @ drop (high x n + 1) treeList) ! i = treeList ! i› ‹i < 2 ^ m› highlowprop valid_insert_both_member_options_pres by auto
moreover have" both_member_options (?nextSummary) i ⟹ ∃ y . both_member_options ((?nextTreeList) ! i) y "
proof-
assume "both_member_options (?nextSummary) i "
have "i ≠ high x n"
by (simp add: False)
hence "both_member_options summary i"
by (smt (z3) "1" "12" ‹both_member_options (if minNull (treeList ! high x n) then VEBT_Insert.vebt_insert summary (high x n) else summary) i› ‹i < 2 ^ m› both_member_options_equiv_member highlowprop post_member_pre_member)
hence "∃ y. both_member_options (treeList ! i) y"
by (simp add: "4" ‹i < 2 ^ m›)
then show ?thesis
using ‹(take (high x n) treeList @ [VEBT_Insert.vebt_insert (treeList ! high x n) (low x n)] @ drop (high x n + 1) treeList) ! i = treeList ! i› by presburger
qed
ultimately show ?thesis by auto
qed
next
case False
hence "?nextSummary = summary" by simp
hence "∃ y. both_member_options (treeList ! high x n) y"
using not_min_Null_member False by blast
hence "both_member_options summary (high x n)"
using "4" highlowprop by blast
hence " both_member_options (?nextTreeList ! high x n) ?l"
by (metis "0" "2" Suc_eq_plus1 append_Cons append_Nil highlowprop nth_list_update_eq nth_mem upd_conv_take_nth_drop valid_insert_both_member_options_add)
then show ?thesis
by (smt (verit, best) "2" "4" False ‹both_member_options summary (high x n)› ‹i < 2 ^ m› highlowprop nth_repl)
qed
qed
qed
have 14: "(mi = max ma x ⟶ (∀ t ∈ set ?nextTreeList. ∄ y. both_member_options t y))"
using True max_less_iff_conj by blast
have 15: "mi ≤ max ma x ∧ max ma x < 2^deg"
using "4.hyps"(8) "4.prems" abcdef by auto
have 16: "(mi ≠ max ma x ⟶ (∀ i < 2^m. (high (max ma x) n = i ⟶ both_member_options (?nextTreeList ! i) (low (max ma x) n)) ∧
(∀ y. (high y n = i ∧ both_member_options (?nextTreeList ! i) (low y n) ) ⟶ mi < y ∧ y ≤ max ma x)))"
proof
assume "mi ≠ max ma x"
show "(∀ i < 2^m. (high (max ma x) n = i ⟶ both_member_options (?nextTreeList ! i) (low (max ma x) n)) ∧
(∀ y. (high y n = i ∧ both_member_options (?nextTreeList ! i) (low y n) ) ⟶ mi < y ∧ y ≤ max ma x))"
proof
fix i::nat
show "i < 2 ^ m⟶
(high (max ma x) n = i ⟶ both_member_options (?nextTreeList ! i) (low (max ma x) n)) ∧
(∀y. high y n = i ∧ both_member_options (?nextTreeList ! i) (low y n) ⟶ mi < y ∧ y ≤ max ma x)"
proof
assume "i < 2^m"
show " (high (max ma x) n = i ⟶ both_member_options (?nextTreeList ! i) (low (max ma x) n)) ∧
(∀y. high y n = i ∧ both_member_options (?nextTreeList ! i) (low y n) ⟶ mi < y ∧ y ≤ max ma x)"
proof
show "(high (max ma x) n = i ⟶ both_member_options (?nextTreeList ! i) (low (max ma x) n))"
proof
assume "high (max ma x) n = i"
show "both_member_options (?nextTreeList ! i) (low (max ma x) n)"
proof(cases "high x n = high ma n")
case True
have "invar_vebt (treeList ! i ) n"
by (metis "0" "2" ‹i < 2 ^ m› in_set_member inthall)
have "length ?nextTreeList = 2^m"
using "2" highlowprop by auto
hence "?nextTreeList ! i = vebt_insert (treeList ! i) (low x n)"
using concat_inth[of "take (high x n) treeList" "vebt_insert (treeList ! i) (low x n)" "drop (high x n + 1) treeList"]
"2" True ‹high (max ma x) n = i› ‹i < 2 ^ m› concat_inth length_take max_def
by (metis Suc_eq_plus1 append_Cons append_Nil nth_list_update_eq upd_conv_take_nth_drop)
hence "vebt_member (?nextTreeList ! i) (low x n)" using Un_iff ‹i < 2 ^ m›
‹invar_vebt (treeList ! i) n› both_member_options_equiv_member highlowprop
list.set_intros(1) set_append valid_insert_both_member_options_add
by (metis "11" True ‹high (max ma x) n = i› max_def)
then show ?thesis proof(cases "mi = ma")
case True
then show ?thesis
by (metis ‹(take (high x n) treeList @ [VEBT_Insert.vebt_insert (treeList ! high x n) (low x n)] @ drop (high x n + 1) treeList) ! i = VEBT_Insert.vebt_insert (treeList ! i) (low x n)› ‹mi ≠ max ma x› ‹invar_vebt (treeList ! i) n› highlowprop max_def valid_insert_both_member_options_add)
next
case False
hence "vebt_member (treeList ! i) (low ma n)"
using "7" True ‹high (max ma x) n = i› ‹i < 2 ^ m› ‹invar_vebt (treeList ! i) n› both_member_options_equiv_member by auto
hence "vebt_member (?nextTreeList ! i) (low ma n) ∨ (low ma n = low x n)"
using post_member_pre_member[of " (treeList ! i)" n "low x n" "low ma n" ]
by (metis "2" "4.IH"(1) ‹(take (high x n) treeList @ [VEBT_Insert.vebt_insert (treeList ! high x n) (low x n)] @ drop (high x n + 1) treeList) ! i = VEBT_Insert.vebt_insert (treeList ! i) (low x n)› ‹i < 2 ^ m› both_member_options_equiv_member highlowprop member_bound nth_mem valid_insert_both_member_options_pres)
then show ?thesis
by (metis "2" "4.IH"(1) True ‹(take (high x n) treeList @ [VEBT_Insert.vebt_insert (treeList ! high x n) (low x n)] @ drop (high x n + 1) treeList) ! i = VEBT_Insert.vebt_insert (treeList ! i) (low x n)› ‹high (max ma x) n = i› both_member_options_equiv_member highlowprop max_def nth_mem valid_insert_both_member_options_add)
qed
next
case False
then show ?thesis
proof(cases "x < ma")
case True
then show ?thesis
by (metis "2" "7" False ‹high (max ma x) n = i› ‹i < 2 ^ m› abcdef highlowprop less_trans max.strict_order_iff nth_repl)
next
case False
hence "x > ma"
using mimaxrel nat_neq_iff by blast
then show ?thesis
by (metis "2" "4.IH"(1) One_nat_def ‹high (max ma x) n = i› add.right_neutral add_Suc_right append_Cons highlowprop max.commute max.strict_order_iff nth_list_update_eq nth_mem self_append_conv2 upd_conv_take_nth_drop valid_insert_both_member_options_add)
qed
qed
qed
show "(∀y. high y n = i ∧ both_member_options (?nextTreeList ! i) (low y n) ⟶ mi < y ∧ y ≤ max ma x)"
proof
fix y
show "high y n = i ∧ both_member_options (?nextTreeList ! i) (low y n) ⟶ mi < y ∧ y ≤ max ma x"
proof
assume bb:"high y n = i ∧ both_member_options (?nextTreeList ! i) (low y n)"
show " mi < y ∧ y ≤ max ma x"
proof(cases "i = high x n")
case True
hence cc:" i = high x n" by simp
have "invar_vebt (treeList ! i ) n"
by (metis "0" "2" ‹i < 2 ^ m› in_set_member inthall)
have "length ?nextTreeList = 2^m"
using "2" highlowprop by auto
hence aa:"?nextTreeList ! i = vebt_insert (treeList ! i) (low x n)"
using concat_inth[of "take (high x n) treeList" "vebt_insert (treeList ! i) (low x n)" "drop (high x n + 1) treeList"]
by (metis "2" Suc_eq_plus1 append_Cons append_self_conv2 cc highlowprop nth_list_update_eq upd_conv_take_nth_drop)
hence "invar_vebt (?nextTreeList ! i) n"
by (simp add: "11" True)
hence "vebt_member (treeList ! i) (low y n) ∨ (low y n) = (low x n)"
by (metis ‹invar_vebt (treeList ! i) n› aa bb highlowprop member_bound post_member_pre_member valid_member_both_member_options)
then show ?thesis
proof(cases "low y n = low x n")
case True
hence "high x n = high y n ∧ low y n = low x n"
by (simp add: bb cc)
hence "x = y"
by (metis bit_split_inv)
then show ?thesis
using abcdef by auto
next
case False
hence "vebt_member (treeList ! i) (low y n)"
using ‹vebt_member (treeList ! i) (low y n) ∨ low y n = low x n› by blast
hence "mi ≠ ma " using 5 inthall
by (metis "2" ‹i < 2 ^ m› min_Null_member not_min_Null_member)
then show ?thesis
using "7" ‹i < 2 ^ m› ‹vebt_member (treeList ! i) (low y n)› ‹invar_vebt (treeList ! i) n› bb both_member_options_equiv_member max.coboundedI1 by blast
qed
next
case False
have "invar_vebt (treeList ! i ) n"
by (metis "0" "2" ‹i < 2 ^ m› in_set_member inthall)
have "length ?nextTreeList = 2^m"
using "2" highlowprop by auto
hence aa:"?nextTreeList ! i = (treeList ! i)"
by (metis "2" False ‹i < 2 ^ m› highlowprop nth_repl)
hence "both_member_options (treeList !i) (low y n)"
using bb by auto
hence "mi ≠ ma " using 5 "2" ‹i < 2 ^ m› by force
then show ?thesis using 7
using ‹both_member_options (treeList ! i) (low y n)› ‹i < 2 ^ m› bb max.coboundedI1 by blast
qed
qed
qed
qed
qed
qed
qed
then show ?thesis using invar_vebt.intros(4)[of ?nextTreeList n ?nextSummary m deg mi "max ma x"]
by (smt (z3) "10" "11" "12" "13" "15" "2" "3" "8" One_nat_def abcdef add.right_neutral add_Suc_right append_Cons highlowprop leD max.cobounded2 max.commute pos_n_replace self_append_conv2 upd_conv_take_nth_drop)
next
case False
hence abcdef: "x < mi"
using antisym_conv3 mimaxrel by blast
let ?h = "high mi n" and ?l="low mi n"
have highlowprop: "high mi n < 2^m ∧ low mi n < 2^n"
using "1" "3" "4.hyps"(3) "4.hyps"(7) "4.hyps"(8) deg_not_0 exp_split_high_low(1) exp_split_high_low(2) le_less_trans by blast
have 10:"vebt_insert (Node (Some (mi,ma)) deg treeList summary) x =
Node (Some (x, max mi ma)) deg (treeList[?h:=vebt_insert (treeList ! ?h) ?l])
(if minNull (treeList ! ?h) then vebt_insert summary ?h else summary) "
by (metis "1" "2" "4.hyps"(3) "9" abcdef deg_not_0 div_greater_zero_iff highlowprop insert_simp_excp mimaxrel)
let ?maxnew = "max mi ma" and ?nextTreeList = "(treeList[ ?h :=vebt_insert (treeList ! ?h) ?l])" and
?nextSummary = "(if minNull (treeList ! ?h) then vebt_insert summary ?h else summary)"
have 11: "( ∀ t ∈ set ?nextTreeList. invar_vebt t n)" proof
fix t
assume " t ∈ set ?nextTreeList"
then obtain i where "?nextTreeList ! i = t ∧ i < 2^m"
by (metis "2" in_set_conv_nth length_list_update)
show "invar_vebt t n"
by (metis "2" "4.IH"(1) ‹treeList[high mi n := VEBT_Insert.vebt_insert (treeList ! high mi n) (low mi n)] ! i = t ∧ i < 2 ^ m› highlowprop nth_list_update_eq nth_list_update_neq nth_mem)
qed
have 12: "invar_vebt ?nextSummary n"
using "1" "4.IH"(2) "8" highlowprop by presburger
have 13: "∀ i < 2^m. (∃ y. both_member_options (?nextTreeList ! i) y) ⟷ ( both_member_options ?nextSummary i)"
proof
fix i
show "i < 2 ^ m ⟶ (∃y. both_member_options ((?nextTreeList) ! i) y) = both_member_options (?nextSummary) i "
proof
assume "i< 2^m"
show "(∃y. both_member_options ((?nextTreeList) ! i) y) = both_member_options (?nextSummary) i "
proof(cases "minNull (treeList ! high mi n)")
case True
hence tc: "minNull (treeList ! high mi n)" by simp
hence nsprop: "?nextSummary = vebt_insert summary ?h" by simp
have insprop:"?nextTreeList ! ?h = vebt_insert (treeList ! ?h) ?l"
by (simp add: "2" highlowprop)
then show ?thesis
proof(cases "i = ?h")
case True
have 161:"∄ y. vebt_member (treeList ! ?h) y"
by (simp add: min_Null_member tc)
hence 162:"∄ y. both_member_options (treeList ! ?h) y"
by (metis "2" "4.IH"(1) highlowprop nth_mem valid_member_both_member_options)
hence 163:"¬ both_member_options summary i"
using "11" "2" "4" True ‹i < 2 ^ m› by blast
have 164:"?nextTreeList ! i = vebt_insert (treeList ! ?h) ?l"
using True insprop by simp
have 165:"invar_vebt (vebt_insert (treeList ! ?h) ?l) n"
by (simp add: "2" "4.IH"(1) highlowprop)
have 166:"both_member_options (vebt_insert (treeList ! ?h) ?l) ?l" using myIHs[of "treeList ! ?h" ?l]
by (metis "0" "2" highlowprop in_set_member inthall valid_insert_both_member_options_add)
have 167:"∃ y. both_member_options ((?nextTreeList) ! i) y "
using "164" "166" by auto
then show ?thesis
using "1" "11" "2" True nsprop valid_insert_both_member_options_add highlowprop by auto
next
case False
have "?nextTreeList ! i = treeList ! i"
using False by fastforce
have fstprop:"both_member_options ((?nextTreeList) ! i) y ⟹ both_member_options (?nextSummary) i " for y
using "1" "4" ‹i < 2 ^ m› ‹treeList[high mi n := VEBT_Insert.vebt_insert (treeList ! high mi n) (low mi n)] ! i = treeList ! i› highlowprop valid_insert_both_member_options_pres by auto
moreover have" both_member_options (?nextSummary) i ⟹ ∃ y . both_member_options ((?nextTreeList) ! i) y "
proof-
assume "both_member_options (?nextSummary) i "
have "i ≠ high mi n"
by (simp add: False)
hence "both_member_options summary i"
by (smt (z3) "1" "12" ‹both_member_options (if minNull (treeList ! high mi n) then VEBT_Insert.vebt_insert summary (high mi n) else summary) i› ‹i < 2 ^ m› both_member_options_equiv_member highlowprop post_member_pre_member)
hence "∃ y. both_member_options (treeList ! i) y"
by (simp add: "4" ‹i < 2 ^ m›)
then show ?thesis
by (simp add: ‹treeList[high mi n := VEBT_Insert.vebt_insert (treeList ! high mi n) (low mi n)] ! i = treeList ! i›)
qed
ultimately show ?thesis by auto
qed
next
case False
hence "?nextSummary = summary" by simp
hence "∃ y. both_member_options (treeList ! high mi n) y"
using not_min_Null_member False by blast
hence "both_member_options summary (high mi n)"
using "4" highlowprop by blast
hence " both_member_options (?nextTreeList ! high mi n) ?l"
by (metis "0" "2" highlowprop nth_list_update_eq nth_mem valid_insert_both_member_options_add)
then show ?thesis
by (metis (full_types, hide_lams) "4" False ‹both_member_options summary (high mi n)› ‹i < 2 ^ m› nth_list_update_neq)
qed
qed
qed
have 14: "(x = max ma mi ⟶ (∀ t ∈ set ?nextTreeList. ∄ y. both_member_options t y))"
using mimaxrel by linarith
have 15: "x ≤ max ma mi ∧ max ma mi < 2^deg"
using "6" abcdef by linarith
have 16: "(x ≠ max ma mi ⟶ (∀ i < 2^m. (high (max ma mi) n = i ⟶ both_member_options (?nextTreeList ! i) (low (max ma mi) n)) ∧
(∀ y. (high y n = i ∧ both_member_options (?nextTreeList ! i) (low y n) ) ⟶ x < y ∧ y ≤ max ma mi)))"
proof
assume "x ≠ max ma mi"
show "(∀ i < 2^m. (high (max ma mi) n = i ⟶ both_member_options (?nextTreeList ! i) (low (max ma mi) n)) ∧
(∀ y. (high y n = i ∧ both_member_options (?nextTreeList ! i) (low y n) ) ⟶ x < y ∧ y ≤ max ma mi))"
proof
fix i::nat
show "i < 2 ^ m⟶
(high (max ma mi) n = i ⟶ both_member_options (?nextTreeList ! i) (low (max ma mi) n)) ∧
(∀y. high y n = i ∧ both_member_options (?nextTreeList ! i) (low y n) ⟶ x < y ∧ y ≤ max ma mi)"
proof
assume "i < 2^m"
show " (high (max ma mi) n = i ⟶ both_member_options (?nextTreeList ! i) (low (max ma mi) n)) ∧
(∀y. high y n = i ∧ both_member_options (?nextTreeList ! i) (low y n) ⟶ x < y ∧ y ≤ max ma mi)"
proof
show "(high (max ma mi) n = i ⟶ both_member_options (?nextTreeList ! i) (low (max ma mi) n))"
proof
assume "high (max ma mi) n = i"
show "both_member_options (?nextTreeList ! i) (low (max ma mi) n)"
proof(cases "high mi n = high ma n")
case True
have "invar_vebt (treeList ! i ) n"
by (metis "0" "2" ‹i < 2 ^ m› in_set_member inthall)
have "length ?nextTreeList = 2^m"
using "2" highlowprop by auto
hence "?nextTreeList ! i = vebt_insert (treeList ! i) (low mi n)"
using concat_inth[of "take (high x n) treeList" "vebt_insert (treeList ! i) (low x n)" "drop (high x n + 1) treeList"]
by (metis "2" True ‹high (max ma mi) n = i› highlowprop max_def nth_list_update_eq)
hence "vebt_member (?nextTreeList ! i) (low mi n)"
by (metis "11" "2" True ‹high (max ma mi) n = i› ‹invar_vebt (treeList ! i) n› highlowprop max_def set_update_memI valid_insert_both_member_options_add valid_member_both_member_options)
then show ?thesis
proof(cases "mi = ma")
case True
then show ?thesis
using ‹treeList[high mi n := VEBT_Insert.vebt_insert (treeList ! high mi n) (low mi n)] ! i = VEBT_Insert.vebt_insert (treeList ! i) (low mi n)› ‹invar_vebt (treeList ! i) n› highlowprop valid_insert_both_member_options_add by force
next
case False
hence "vebt_member (treeList ! i) (low ma n)"
using "6" "7" ‹high (max ma mi) n = i› ‹i < 2 ^ m› ‹invar_vebt (treeList ! i) n› both_member_options_equiv_member by auto
hence "vebt_member (?nextTreeList ! i) (low ma n) ∨ (low ma n = low mi n)"
using post_member_pre_member[of " (treeList ! i)" n "low mi n" "low ma n" ]
by (metis "11" "2" "7" True ‹high (max ma mi) n = i› ‹treeList[high mi n := VEBT_Insert.vebt_insert (treeList ! high mi n) (low mi n)] ! i = VEBT_Insert.vebt_insert (treeList ! i) (low mi n)› ‹invar_vebt (treeList ! i) n› highlowprop max_def member_bound set_update_memI valid_insert_both_member_options_pres valid_member_both_member_options)
then show ?thesis
by (metis "11" "2" "4.hyps"(7) "7" False True ‹high (max ma mi) n = i› ‹treeList[high mi n := VEBT_Insert.vebt_insert (treeList ! high mi n) (low mi n)] ! i = VEBT_Insert.vebt_insert (treeList ! i) (low mi n)› both_member_options_equiv_member highlowprop less_irrefl max.commute max_def set_update_memI)
qed
next
case False
hence "?nextTreeList ! i = treeList ! i"
by (metis "4.hyps"(7) ‹high (max ma mi) n = i› max.commute max_def nth_list_update_neq)
then show ?thesis
by (metis "4.hyps"(7) "7" False ‹high (max ma mi) n = i› ‹i < 2 ^ m› max.orderE)
qed
qed
show "(∀y. high y n = i ∧ both_member_options (?nextTreeList ! i) (low y n) ⟶ x < y ∧ y ≤ max ma mi)"
proof
fix y
show "high y n = i ∧ both_member_options (?nextTreeList ! i) (low y n) ⟶ x < y ∧ y ≤ max ma mi"
proof
assume bb:"high y n = i ∧ both_member_options (?nextTreeList ! i) (low y n)"
show " x < y ∧ y ≤ max ma mi"
proof(cases "i = high mi n")
case True
hence cc:" i = high mi n" by simp
have "invar_vebt (treeList ! i ) n"
by (metis "0" "2" ‹i < 2 ^ m› in_set_member inthall)
have "length ?nextTreeList = 2^m"
using "2" highlowprop by auto
hence aa:"?nextTreeList ! i = vebt_insert (treeList ! i) (low mi n)"
using concat_inth[of "take (high x n) treeList" "vebt_insert (treeList ! i) (low x n)" "drop (high x n + 1) treeList"]
by (simp add: cc highlowprop)
hence "invar_vebt (?nextTreeList ! i) n"
by (simp add: "2" "4.IH"(1) cc highlowprop)
hence "vebt_member (treeList ! i) (low y n) ∨ (low y n) = (low mi n)"
by (metis ‹invar_vebt (treeList ! i) n› aa bb both_member_options_equiv_member highlowprop member_bound post_member_pre_member)
then show ?thesis
proof(cases "low y n = low mi n")
case True
hence "high mi n = high y n ∧ low y n = low mi n"
by (simp add: bb cc)
hence "mi = y"
by (metis bit_split_inv)
then show ?thesis
using abcdef by auto
next
case False
hence "vebt_member (treeList ! i) (low y n)"
using ‹vebt_member (treeList ! i) (low y n) ∨ low y n = low mi n› by blast
hence "mi ≠ ma " using 5 inthall
by (metis "2" ‹i < 2 ^ m› min_Null_member not_min_Null_member)
then show ?thesis
using "7"
by (metis ‹i < 2 ^ m› ‹vebt_member (treeList ! i) (low y n)› ‹invar_vebt (treeList ! i) n› abcdef bb both_member_options_equiv_member max.absorb1 max.strict_order_iff max_less_iff_conj)
qed
next
case False
have "invar_vebt (treeList ! i ) n"
by (metis "0" "2" ‹i < 2 ^ m› in_set_member inthall)
have "length ?nextTreeList = 2^m"
using "2" highlowprop by auto
hence aa:"?nextTreeList ! i = (treeList ! i)"
using False by auto
hence "both_member_options (treeList ! i) (low y n)"
using bb by auto
hence "mi ≠ ma " using 5 "2" ‹i < 2 ^ m› by force
then show ?thesis using 7
by (metis ‹both_member_options (treeList ! i) (low y n)› ‹i < 2 ^ m› abcdef bb max.absorb1 max.strict_order_iff max_less_iff_conj)
qed
qed
qed
qed
qed
qed
qed
then show ?thesis using invar_vebt.intros(4)[of ?nextTreeList n ?nextSummary m deg x "max ma mi"]
by (smt (z3) "10" "11" "12" "13" "14" "15" "2" "3" "4.hyps"(3) "4.hyps"(7) length_list_update max.absorb1 max.absorb2)
qed
qed
next
case (5 treeList n summary m deg mi ma)
hence myIHs: "x ∈ set treeList ⟹ invar_vebt x n ⟹ xa < 2 ^ n ⟹ invar_vebt (vebt_insert x xa) n" for x xa by simp
hence 0: "( ∀ t ∈ set treeList. invar_vebt t n)" and 1: " invar_vebt summary m" and 2:"length treeList = 2^m" and 3:" deg = n+m" and
4: "(∀ i < 2^m. (∃ y. both_member_options (treeList ! i) y) ⟷ ( both_member_options summary i))" and
5: "(mi = ma ⟶ (∀ t ∈ set treeList. ∄ y. both_member_options t y))" and 6:"mi ≤ ma ∧ ma < 2^deg" and
7: "(mi ≠ ma ⟶ (∀ i < 2^m. (high ma n = i ⟶ both_member_options (treeList ! i) (low ma n)) ∧
(∀ y. (high y n = i ∧ both_member_options (treeList ! i) (low y n) ) ⟶ mi < y ∧ y ≤ ma)))"
and 8: "Suc n = m" and 9: "deg div 2 = n"
using "5" add_self_div_2 apply blast+ by (simp add: "5.hyps"(3) "5.hyps"(4))
then show ?case
proof(cases "x = mi ∨ x = ma")
case True
then show ?thesis using insert_simp_mima[of x mi ma deg treeList summary]
invar_vebt.intros(5)[of treeList n summary m deg mi ma]
by (smt "0" "1" "2" "3" "4" "5" "5.hyps"(3) "5.hyps"(7) "5.hyps"(8) "7" "9" div_less not_less not_one_le_zero set_n_deg_not_0)
next
case False
hence mimaxrel: "x ≠ mi ∧ x ≠ ma" by simp
then show ?thesis
proof(cases "mi < x")
case True
hence abcdef: "mi < x" by simp
let ?h = "high x n" and ?l="low x n"
have highlowprop: "high x n < 2^m ∧ low x n < 2^n"
by (metis "1" "2" "3" "5.IH"(1) "5.prems" Euclidean_Division.div_eq_0_iff add_nonneg_eq_0_iff deg_not_0 div_exp_eq exp_split_high_low(2) high_def not_one_le_zero one_add_one power_not_zero set_n_deg_not_0 zero_le_one zero_neq_one)
have 10:"vebt_insert (Node (Some (mi,ma)) deg treeList summary) x =
Node (Some (mi, max x ma)) deg (treeList[?h :=vebt_insert (treeList ! ?h) ?l])
(if minNull (treeList ! ?h) then vebt_insert summary ?h else summary) "
using "2" "3" False True ‹high x n < 2 ^ m ∧ low x n < 2 ^ n› insert_simp_norm
by (smt "5.IH"(1) "9" div_greater_zero_iff div_if less_Suc_eq_0_disj not_one_le_zero set_n_deg_not_0)
let ?maxnew = "max x ma" and ?nextTreeList = "(treeList[ ?h :=vebt_insert (treeList ! ?h) ?l])" and
?nextSummary = "(if minNull (treeList ! ?h) then vebt_insert summary ?h else summary)"
have 11: "( ∀ t ∈ set ?nextTreeList. invar_vebt t n)"
proof
fix t
assume " t ∈ set ?nextTreeList"
then obtain i where "i <2^m ∧ ?nextTreeList ! i = t"
by (metis "2" in_set_conv_nth length_list_update)
show "invar_vebt t n"
by (metis "2" "5.IH"(1) ‹i < 2 ^ m ∧ treeList[high x n := VEBT_Insert.vebt_insert (treeList ! high x n) (low x n)] ! i = t› highlowprop nth_list_update_eq nth_list_update_neq nth_mem)
qed
have 12: "invar_vebt ?nextSummary m"
by (simp add: "1" "5.IH"(2) highlowprop)
have 13: "∀ i < 2^m. (∃ y. both_member_options (?nextTreeList ! i) y) ⟷ ( both_member_options ?nextSummary i)"
proof
fix i
show "i < 2 ^ m ⟶ (∃y. both_member_options ((?nextTreeList) ! i) y) = both_member_options (?nextSummary) i "
proof
assume "i< 2^m"
show "(∃y. both_member_options ((?nextTreeList) ! i) y) = both_member_options (?nextSummary) i "
proof(cases "minNull (treeList ! high x n)")
case True
hence tc: "minNull (treeList ! high x n)" by simp
hence nsprop: "?nextSummary = vebt_insert summary ?h" by simp
have insprop:"?nextTreeList ! ?h = vebt_insert (treeList ! ?h) ?l"
by (simp add: "2" highlowprop)
then show ?thesis
proof(cases "i = ?h")
case True
have 161:"∄ y. vebt_member (treeList ! ?h) y"
by (simp add: min_Null_member tc)
hence 162:"∄ y. both_member_options (treeList ! ?h) y"
by (metis "0" "2" highlowprop nth_mem valid_member_both_member_options)
hence 163:"¬ both_member_options summary i"
using "11" "2" "4" True ‹i < 2 ^ m› by blast
have 164:"?nextTreeList ! i = vebt_insert (treeList ! ?h) ?l"
using True insprop by simp
have 165:"invar_vebt (vebt_insert (treeList ! ?h) ?l) n"
by (simp add: "11" "2" highlowprop set_update_memI)
have 166:"both_member_options (vebt_insert (treeList ! ?h) ?l) ?l" using myIHs[of "treeList ! ?h" ?l]
by (metis "0" "2" highlowprop in_set_member inthall valid_insert_both_member_options_add)
have 167:"∃ y. both_member_options ((?nextTreeList) ! i) y "
using "164" "166" by auto
then show ?thesis
using "1" "11" "2" True nsprop valid_insert_both_member_options_add highlowprop by auto
next
case False
have "?nextTreeList ! i = treeList ! i"
using False by auto
have fstprop:"both_member_options ((?nextTreeList) ! i) y ⟹ both_member_options (?nextSummary) i " for y
using "1" "4" ‹i < 2 ^ m› ‹treeList[high x n := VEBT_Insert.vebt_insert (treeList ! high x n) (low x n)] ! i = treeList ! i› highlowprop valid_insert_both_member_options_pres by auto
moreover have" both_member_options (?nextSummary) i ⟹ ∃ y . both_member_options ((?nextTreeList) ! i) y "
proof-
assume "both_member_options (?nextSummary) i "
have "i ≠ high x n"
by (simp add: False)
hence "both_member_options summary i"
by (smt "1" "12" ‹both_member_options (if minNull (treeList ! high x n) then vebt_insert summary (high x n) else summary) i› ‹i < 2 ^ m› both_member_options_equiv_member highlowprop post_member_pre_member)
hence "∃ y. both_member_options (treeList ! i) y"
by (simp add: "4" ‹i < 2 ^ m›)
then show ?thesis
by (simp add: ‹treeList[high x n := VEBT_Insert.vebt_insert (treeList ! high x n) (low x n)] ! i = treeList ! i›)
qed
ultimately show ?thesis by auto
qed
next
case False
hence "?nextSummary = summary" by simp
hence "∃ y. both_member_options (treeList ! high x n) y"
using not_min_Null_member False by blast
hence "both_member_options summary (high x n)"
using "4" highlowprop by blast
hence " both_member_options (?nextTreeList ! high x n) ?l"
by (metis "0" "2" highlowprop nth_list_update_eq nth_mem valid_insert_both_member_options_add)
then show ?thesis
by (metis (full_types) "4" False ‹both_member_options summary (high x n)› ‹i < 2 ^ m› nth_list_update_neq)
qed
qed
qed
have 14: "(mi = max ma x ⟶ (∀ t ∈ set ?nextTreeList. ∄ y. both_member_options t y))"
using True max_less_iff_conj by blast
have 15: "mi ≤ max ma x ∧ max ma x < 2^deg"
using "5.hyps"(8) "5.prems" abcdef by auto
have 16: "(mi ≠ max ma x ⟶ (∀ i < 2^m. (high (max ma x) n = i ⟶ both_member_options (?nextTreeList ! i) (low (max ma x) n)) ∧
(∀ y. (high y n = i ∧ both_member_options (?nextTreeList ! i) (low y n) ) ⟶ mi < y ∧ y ≤ max ma x)))"
proof
assume "mi ≠ max ma x"
show "(∀ i < 2^m. (high (max ma x) n = i ⟶ both_member_options (?nextTreeList ! i) (low (max ma x) n)) ∧
(∀ y. (high y n = i ∧ both_member_options (?nextTreeList ! i) (low y n) ) ⟶ mi < y ∧ y ≤ max ma x))"
proof
fix i::nat
show "i < 2 ^ m⟶
(high (max ma x) n = i ⟶ both_member_options (?nextTreeList ! i) (low (max ma x) n)) ∧
(∀y. high y n = i ∧ both_member_options (?nextTreeList ! i) (low y n) ⟶ mi < y ∧ y ≤ max ma x)"
proof
assume "i < 2^m"
show " (high (max ma x) n = i ⟶ both_member_options (?nextTreeList ! i) (low (max ma x) n)) ∧
(∀y. high y n = i ∧ both_member_options (?nextTreeList ! i) (low y n) ⟶ mi < y ∧ y ≤ max ma x)"
proof
show "(high (max ma x) n = i ⟶ both_member_options (?nextTreeList ! i) (low (max ma x) n))"
proof
assume "high (max ma x) n = i"
show "both_member_options (?nextTreeList ! i) (low (max ma x) n)"
proof(cases "high x n = high ma n")
case True
have "invar_vebt (treeList ! i ) n"
by (metis "0" "2" ‹i < 2 ^ m› in_set_member inthall)
have "length ?nextTreeList = 2^m"
using "2" highlowprop by auto
hence "?nextTreeList ! i = vebt_insert (treeList ! i) (low x n)"
using concat_inth[of "take (high x n) treeList" "vebt_insert (treeList ! i) (low x n)" "drop (high x n + 1) treeList"]
by (metis "2" False True ‹high (max ma x) n = i› highlowprop linorder_neqE_nat max.commute max.strict_order_iff nth_list_update_eq)
hence "vebt_member (?nextTreeList ! i) (low x n)"
by (metis "11" "2" True ‹high (max ma x) n = i› ‹invar_vebt (treeList ! i) n› highlowprop max_def set_update_memI valid_insert_both_member_options_add valid_member_both_member_options)
then show ?thesis
proof(cases "mi = ma")
case True
then show ?thesis
by (metis ‹treeList[high x n := VEBT_Insert.vebt_insert (treeList ! high x n) (low x n)] ! i = VEBT_Insert.vebt_insert (treeList ! i) (low x n)› ‹invar_vebt (treeList ! i) n› abcdef highlowprop max.commute max.strict_order_iff valid_insert_both_member_options_add)
next
case False
hence "vebt_member (treeList ! i) (low ma n)"
by (metis "7" True ‹high (max ma x) n = i› ‹invar_vebt (treeList ! i) n› highlowprop max_def valid_member_both_member_options)
hence "vebt_member (?nextTreeList ! i) (low ma n) ∨ (low ma n = low x n)"
using post_member_pre_member[of " (treeList ! i)" n "low x n" "low ma n" ]
by (metis "1" "11" "2" "3" "5.hyps"(8) "7" False True ‹treeList[high x n := VEBT_Insert.vebt_insert (treeList ! high x n) (low x n)] ! i = VEBT_Insert.vebt_insert (treeList ! i) (low x n)› ‹invar_vebt (treeList ! i) n› deg_not_0 exp_split_high_low(2) highlowprop nth_list_update_neq set_update_memI valid_insert_both_member_options_pres valid_member_both_member_options)
then show ?thesis
by (metis "11" "2" True ‹high (max ma x) n = i› ‹treeList[high x n := VEBT_Insert.vebt_insert (treeList ! high x n) (low x n)] ! i = VEBT_Insert.vebt_insert (treeList ! i) (low x n)› ‹invar_vebt (treeList ! i) n› both_member_options_equiv_member highlowprop max_def set_update_memI valid_insert_both_member_options_add)
qed
next
case False
then show ?thesis
by (metis "0" "2" "7" ‹high (max ma x) n = i› ‹i < 2 ^ m› ‹mi ≠ max ma x› highlowprop max_def nth_list_update_eq nth_list_update_neq nth_mem valid_insert_both_member_options_add)
qed
qed
show "(∀y. high y n = i ∧ both_member_options (?nextTreeList ! i) (low y n) ⟶ mi < y ∧ y ≤ max ma x)"
proof
fix y
show "high y n = i ∧ both_member_options (?nextTreeList ! i) (low y n) ⟶ mi < y ∧ y ≤ max ma x"
proof
assume bb:"high y n = i ∧ both_member_options (?nextTreeList ! i) (low y n)"
show " mi < y ∧ y ≤ max ma x"
proof(cases "i = high x n")
case True
hence cc:" i = high x n" by simp
have "invar_vebt (treeList ! i ) n"
by (metis "0" "2" ‹i < 2 ^ m› in_set_member inthall)
have "length ?nextTreeList = 2^m"
using "2" highlowprop by auto
hence aa:"?nextTreeList ! i = vebt_insert (treeList ! i) (low x n)"
using concat_inth[of "take (high x n) treeList" "vebt_insert (treeList ! i) (low x n)" "drop (high x n + 1) treeList"]
by (simp add: cc highlowprop)
hence "invar_vebt (?nextTreeList ! i) n"
by (simp add: "2" "5.IH"(1) cc highlowprop)
hence "vebt_member (treeList ! i) (low y n) ∨ (low y n) = (low x n)"
by (metis ‹high y n = i ∧ both_member_options ((treeList[?h:=vebt_insert (treeList ! high x n) (low x n)]) ! i) (low y n)›
‹invar_vebt (treeList ! i) n› aa highlowprop member_bound post_member_pre_member valid_member_both_member_options)
then show ?thesis
proof(cases "low y n = low x n")
case True
hence "high x n = high y n ∧ low y n = low x n"
by (simp add: bb cc)
hence "x = y"
by (metis bit_split_inv)
then show ?thesis
using abcdef by auto
next
case False
hence "vebt_member (treeList ! i) (low y n)"
using ‹vebt_member (treeList ! i) (low y n) ∨ low y n = low x n› by blast
hence "mi ≠ ma " using 5 inthall
by (metis "2" ‹i < 2 ^ m› min_Null_member not_min_Null_member)
then show ?thesis
using "7" ‹i < 2 ^ m› ‹vebt_member (treeList ! i) (low y n)› ‹invar_vebt (treeList ! i) n› bb both_member_options_equiv_member max.coboundedI1 by blast
qed
next
case False
have "invar_vebt (treeList ! i ) n"
by (metis "0" "2" ‹i < 2 ^ m› in_set_member inthall)
have "length ?nextTreeList = 2^m"
using "2" highlowprop by auto
hence aa:"?nextTreeList ! i = (treeList ! i)"
using False by auto
hence "both_member_options (treeList ! i) (low y n)"
using bb by auto
hence "mi ≠ ma " using 5
using "2" ‹i < 2 ^ m› by fastforce
then show ?thesis using 7
using ‹both_member_options (treeList ! i) (low y n)› ‹i < 2 ^ m› bb max.coboundedI1 by blast
qed
qed
qed
qed
qed
qed
qed
then show ?thesis using invar_vebt.intros(5)[of ?nextTreeList n ?nextSummary m deg mi "max ma x"]
by (smt (z3) "10" "11" "12" "13" "14" "15" "2" "3" "8" length_list_update max.commute)
next
case False
hence abcdef: "x < mi"
using antisym_conv3 mimaxrel by blast
let ?h = "high mi n" and ?l="low mi n"
have highlowprop: "high mi n < 2^m ∧ low mi n < 2^n"
by (metis (full_types) "1" "2" "3" "5.IH"(1) "5.hyps"(7) "5.hyps"(8) deg_not_0 exp_split_high_low(1) exp_split_high_low(2) le_less_trans not_one_le_zero set_n_deg_not_0)
have 10:"vebt_insert (Node (Some (mi,ma)) deg treeList summary) x =
Node (Some (x, max mi ma)) deg (treeList[ ?h :=vebt_insert (treeList ! ?h) ?l])
(if minNull (treeList ! ?h) then vebt_insert summary ?h else summary) "
by (metis "0" "2" "9" abcdef div_less highlowprop insert_simp_excp mimaxrel not_less not_one_le_zero set_n_deg_not_0)
let ?maxnew = "max mi ma" and ?nextTreeList = "(treeList[ ?h:=vebt_insert (treeList ! ?h) ?l])" and
?nextSummary = "(if minNull (treeList ! ?h) then vebt_insert summary ?h else summary)"
have 11: "( ∀ t ∈ set ?nextTreeList. invar_vebt t n)"
proof
fix t
assume " t ∈ set ?nextTreeList"
then obtain i where "i < 2^m ∧ ?nextTreeList ! i = t"
by (metis "2" in_set_conv_nth length_list_update)
thus "invar_vebt t n"
by (metis "2" "5.IH"(1) highlowprop nth_list_update_eq nth_list_update_neq nth_mem)
qed
have 12: "invar_vebt ?nextSummary m"
by (simp add: "1" "5.IH"(2) highlowprop)
have 13: "∀ i < 2^m. (∃ y. both_member_options (?nextTreeList ! i) y) ⟷ ( both_member_options ?nextSummary i)"
proof
fix i
show "i < 2 ^ m ⟶ (∃y. both_member_options ((?nextTreeList) ! i) y) = both_member_options (?nextSummary) i "
proof
assume "i< 2^m"
show "(∃y. both_member_options ((?nextTreeList) ! i) y) = both_member_options (?nextSummary) i "
proof(cases "minNull (treeList ! high mi n)")
case True
hence tc: "minNull (treeList ! high mi n)" by simp
hence nsprop: "?nextSummary = vebt_insert summary ?h" by simp
have insprop:"?nextTreeList ! ?h = vebt_insert (treeList ! ?h) ?l"
by (simp add: "2" highlowprop)
then show ?thesis
proof(cases "i = ?h")
case True
have 161:"∄ y. vebt_member (treeList ! ?h) y"
by (simp add: min_Null_member tc)
hence 162:"∄ y. both_member_options (treeList ! ?h) y"
by (metis "0" "2" highlowprop nth_mem valid_member_both_member_options)
hence 163:"¬ both_member_options summary i"
using "11" "2" "4" True ‹i < 2 ^ m› by blast
have 164:"?nextTreeList ! i = vebt_insert (treeList ! ?h) ?l"
using True insprop by simp
have 165:"invar_vebt (vebt_insert (treeList ! ?h) ?l) n"
by (simp add: "11" "2" highlowprop set_update_memI)
have 166:"both_member_options (vebt_insert (treeList ! ?h) ?l) ?l" using myIHs[of "treeList ! ?h" ?l]
by (metis "0" "2" highlowprop in_set_member inthall valid_insert_both_member_options_add)
have 167:"∃ y. both_member_options ((?nextTreeList) ! i) y "
using "164" "166" by auto
then show ?thesis
using "1" "11" "2" True nsprop valid_insert_both_member_options_add highlowprop by auto
next
case False
have "?nextTreeList ! i = treeList ! i"
by (metis False nth_list_update_neq)
have fstprop:"both_member_options ((?nextTreeList) ! i) y ⟹ both_member_options (?nextSummary) i " for y
using "1" "4" ‹i < 2 ^ m› ‹treeList[high mi n := VEBT_Insert.vebt_insert (treeList ! high mi n) (low mi n)] ! i = treeList ! i› highlowprop valid_insert_both_member_options_pres by auto
moreover have" both_member_options (?nextSummary) i ⟹ ∃ y . both_member_options ((?nextTreeList) ! i) y "
proof-
assume "both_member_options (?nextSummary) i "
have "i ≠ high mi n"
by (simp add: False)
hence "both_member_options summary i"
by (smt (z3) "1" "12" ‹both_member_options (if minNull (treeList ! high mi n) then VEBT_Insert.vebt_insert summary (high mi n) else summary) i› ‹i < 2 ^ m› both_member_options_equiv_member highlowprop post_member_pre_member)
hence "∃ y. both_member_options (treeList ! i) y"
by (simp add: "4" ‹i < 2 ^ m›)
then show ?thesis
by (simp add: ‹treeList[high mi n := VEBT_Insert.vebt_insert (treeList ! high mi n) (low mi n)] ! i = treeList ! i›)
qed
ultimately show ?thesis by auto
qed
next
case False
hence "?nextSummary = summary" by simp
hence "∃ y. both_member_options (treeList ! high mi n) y"
using not_min_Null_member False by blast
hence "both_member_options summary (high mi n)"
using "4" highlowprop by blast
hence " both_member_options (?nextTreeList ! high mi n) ?l"
by (metis "0" "2" highlowprop nth_list_update_eq nth_mem valid_insert_both_member_options_add)
then show ?thesis
by (metis (full_types) "4" False ‹both_member_options summary (high mi n)› ‹i < 2 ^ m› nth_list_update_neq)
qed
qed
qed
have 14: "(x = max ma mi ⟶ (∀ t ∈ set ?nextTreeList. ∄ y. both_member_options t y))"
using mimaxrel by linarith
have 15: "x ≤ max ma mi ∧ max ma mi < 2^deg"
using "6" abcdef by linarith
have 16: "(x ≠ max ma mi ⟶ (∀ i < 2^m. (high (max ma mi) n = i ⟶ both_member_options (?nextTreeList ! i) (low (max ma mi) n)) ∧
(∀ y. (high y n = i ∧ both_member_options (?nextTreeList ! i) (low y n) ) ⟶ x < y ∧ y ≤ max ma mi)))"
proof
assume "x ≠ max ma mi"
show "(∀ i < 2^m. (high (max ma mi) n = i ⟶ both_member_options (?nextTreeList ! i) (low (max ma mi) n)) ∧
(∀ y. (high y n = i ∧ both_member_options (?nextTreeList ! i) (low y n) ) ⟶ x < y ∧ y ≤ max ma mi))"
proof
fix i::nat
show "i < 2 ^ m⟶
(high (max ma mi) n = i ⟶ both_member_options (?nextTreeList ! i) (low (max ma mi) n)) ∧
(∀y. high y n = i ∧ both_member_options (?nextTreeList ! i) (low y n) ⟶ x < y ∧ y ≤ max ma mi)"
proof
assume "i < 2^m"
show " (high (max ma mi) n = i ⟶ both_member_options (?nextTreeList ! i) (low (max ma mi) n)) ∧
(∀y. high y n = i ∧ both_member_options (?nextTreeList ! i) (low y n) ⟶ x < y ∧ y ≤ max ma mi)"
proof
show "(high (max ma mi) n = i ⟶ both_member_options (?nextTreeList ! i) (low (max ma mi) n))"
proof
assume "high (max ma mi) n = i"
show "both_member_options (?nextTreeList ! i) (low (max ma mi) n)"
proof(cases "high mi n = high ma n")
case True
have "invar_vebt (treeList ! i ) n"
by (metis "0" "2" ‹i < 2 ^ m› in_set_member inthall)
have "length ?nextTreeList = 2^m"
using "2" highlowprop by auto
hence "?nextTreeList ! i = vebt_insert (treeList ! i) (low mi n)"
using concat_inth[of "take (high x n) treeList" "vebt_insert (treeList ! i) (low x n)" "drop (high x n + 1) treeList"]
by (metis "2" "5.hyps"(7) True ‹high (max ma mi) n = i› highlowprop max.orderE nth_list_update_eq)
hence "vebt_member (?nextTreeList ! i) (low mi n)"
by (metis "11" "2" True ‹high (max ma mi) n = i› ‹invar_vebt (treeList ! i) n› highlowprop max_def set_update_memI valid_insert_both_member_options_add valid_member_both_member_options)
then show ?thesis
proof(cases "mi = ma")
case True
then show ?thesis
using ‹treeList[high mi n := VEBT_Insert.vebt_insert (treeList ! high mi n) (low mi n)] ! i = VEBT_Insert.vebt_insert (treeList ! i) (low mi n)› ‹invar_vebt (treeList ! i) n› highlowprop valid_insert_both_member_options_add by auto
next
case False
hence "vebt_member (treeList ! i) (low ma n)"
using "6" "7" ‹high (max ma mi) n = i› ‹i < 2 ^ m› ‹invar_vebt (treeList ! i) n› both_member_options_equiv_member by auto
hence "vebt_member (?nextTreeList ! i) (low ma n) ∨ (low ma n = low mi n)"
using post_member_pre_member[of " (treeList ! i)" n "low mi n" "low ma n" ]
by (metis "1" "11" "2" "3" "5.hyps"(8) "7" True ‹high (max ma mi) n = i› ‹treeList[high mi n := VEBT_Insert.vebt_insert (treeList ! high mi n) (low mi n)] ! i = VEBT_Insert.vebt_insert (treeList ! i) (low mi n)› ‹invar_vebt (treeList ! i) n› deg_not_0 exp_split_high_low(2) highlowprop max_def set_update_memI valid_insert_both_member_options_pres valid_member_both_member_options)
then show ?thesis
by (metis "5.hyps"(7) "7" False ‹high (max ma mi) n = i› ‹i < 2 ^ m› ‹vebt_member (treeList ! i) (low ma n)› ‹treeList[high mi n := VEBT_Insert.vebt_insert (treeList ! high mi n) (low mi n)] ! i = VEBT_Insert.vebt_insert (treeList ! i) (low mi n)› ‹invar_vebt (treeList ! i) n› highlowprop max.absorb1 member_bound valid_insert_both_member_options_pres)
qed
next
case False
hence "?nextTreeList ! i = treeList ! i"
by (metis "5.hyps"(7) ‹high (max ma mi) n = i› max.commute max_def nth_list_update_neq)
then show ?thesis
proof(cases "mi < ma")
case True
then show ?thesis
by (metis "5.hyps"(7) "7" False ‹high (max ma mi) n = i› ‹i < 2 ^ m› ‹treeList[high mi n := VEBT_Insert.vebt_insert (treeList ! high mi n) (low mi n)] ! i = treeList ! i› max.commute max_def)
next
case False
hence "mi ≥ ma " by simp
hence "mi = ma"
by (simp add: "6" eq_iff)
hence "¬both_member_options (treeList ! i) (low (max ma mi) n)" using 5 "2" ‹i < 2 ^ m› by auto
then show ?thesis
by (metis "11" "2" ‹high (max ma mi) n = i› ‹mi = ma› ‹treeList[high mi n := VEBT_Insert.vebt_insert (treeList ! high mi n) (low mi n)] ! i = treeList ! i› highlowprop max.idem nth_list_update_eq set_update_memI valid_insert_both_member_options_add)
qed
qed
qed
show "(∀y. high y n = i ∧ both_member_options (?nextTreeList ! i) (low y n) ⟶ x < y ∧ y ≤ max ma mi)"
proof
fix y
show "high y n = i ∧ both_member_options (?nextTreeList ! i) (low y n) ⟶ x < y ∧ y ≤ max ma mi"
proof
assume bb:"high y n = i ∧ both_member_options (?nextTreeList ! i) (low y n)"
show " x < y ∧ y ≤ max ma mi"
proof(cases "i = high mi n")
case True
hence cc:" i = high mi n" by simp
have "invar_vebt (treeList ! i ) n"
by (metis "0" "2" ‹i < 2 ^ m› in_set_member inthall)
have "length ?nextTreeList = 2^m"
using "2" highlowprop by auto
hence aa:"?nextTreeList ! i = vebt_insert (treeList ! i) (low mi n)"
using concat_inth[of "take (high x n) treeList" "vebt_insert (treeList ! i) (low x n)" "drop (high x n + 1) treeList"]
by (simp add: cc highlowprop)
hence "invar_vebt (?nextTreeList ! i) n"
by (simp add: "2" "5.IH"(1) ‹i < 2 ^ m› highlowprop)
hence "vebt_member (treeList ! i) (low y n) ∨ (low y n) = (low mi n)"
by (metis ‹invar_vebt (treeList ! i) n› aa bb both_member_options_equiv_member highlowprop member_bound post_member_pre_member)
then show ?thesis
proof(cases "low y n = low mi n")
case True
hence "high mi n = high y n ∧ low y n = low mi n"
by (simp add: bb cc)
hence "mi = y"
by (metis bit_split_inv)
then show ?thesis
using abcdef by auto
next
case False
hence "vebt_member (treeList ! i) (low y n)"
using ‹vebt_member (treeList ! i) (low y n) ∨ low y n = low mi n› by blast
hence "mi ≠ ma " using 5 inthall
by (metis "2" ‹i < 2 ^ m› min_Null_member not_min_Null_member)
then show ?thesis
using "7"
by (metis ‹i < 2 ^ m› ‹vebt_member (treeList ! i) (low y n)› ‹invar_vebt (treeList ! i) n› abcdef bb both_member_options_equiv_member max.absorb1 max.strict_order_iff max_less_iff_conj)
qed
next
case False
have "invar_vebt (treeList ! i ) n"
by (metis "0" "2" ‹i < 2 ^ m› in_set_member inthall)
have "length ?nextTreeList = 2^m"
using "2" highlowprop by auto
hence aa:"?nextTreeList ! i = (treeList ! i)"
using False by auto
hence "both_member_options (treeList ! i) (low y n)"
using bb by auto
hence "mi ≠ ma " using 5 "2" ‹i < 2 ^ m› by fastforce
then show ?thesis using 7
by (metis ‹both_member_options (treeList ! i) (low y n)› ‹i < 2 ^ m› abcdef bb max.absorb1 max.strict_order_iff max_less_iff_conj)
qed
qed
qed
qed
qed
qed
qed
then show ?thesis using invar_vebt.intros(5)[of ?nextTreeList n ?nextSummary m deg x "max ma mi"]
by (smt (z3) "10" "11" "12" "13" "14" "15" "2" "3" "5.hyps"(7) "8" length_list_update max.absorb2 max.orderE)
qed
qed
qed
subsection ‹Correctness with Respect to Set Interpretation›
theorem insert_corr:
assumes "invar_vebt t n " and "x < 2^n "
shows " set_vebt' t ∪ {x} = set_vebt' (vebt_insert t x) "
proof
show "set_vebt' t ∪ {x} ⊆ set_vebt' (vebt_insert t x)"
proof
fix y
assume "y ∈ set_vebt' t ∪ {x}"
show "y ∈set_vebt' (vebt_insert t x)"
proof(cases "x=y")
case True
then show ?thesis
by (metis (full_types) assms(1) assms(2) both_member_options_equiv_member mem_Collect_eq set_vebt'_def valid_insert_both_member_options_add valid_pres_insert)
next
case False
have "vebt_member t y"
using False ‹y ∈ set_vebt' t ∪ {x}› set_vebt'_def by auto
hence "vebt_member (vebt_insert t x) y"
by (meson assms(1) assms(2) both_member_options_equiv_member member_bound valid_insert_both_member_options_pres valid_pres_insert)
then show ?thesis
by (simp add: set_vebt'_def)
qed
qed
show " set_vebt' (vebt_insert t x) ⊆ set_vebt' t ∪ {x} "
proof
fix y
assume "y ∈ set_vebt' (vebt_insert t x)"
show "y ∈set_vebt' t ∪ {x}"
proof(cases "x=y")
case True
then show ?thesis by simp
next
case False
hence "vebt_member t y ∨ x=y" using post_member_pre_member
using ‹y ∈ set_vebt' (vebt_insert t x)› assms(1) assms(2) set_vebt'_def member_bound valid_pres_insert by fastforce
hence "vebt_member t y"
by (simp add: False)
hence "y ∈ set_vebt' t"
by (simp add: set_vebt'_def)
then show ?thesis by simp
qed
qed
qed
corollary insert_correct: assumes "invar_vebt t n " and "x < 2^n " shows
" set_vebt t ∪ {x} = set_vebt (vebt_insert t x) "
using assms(1) assms(2) insert_corr set_vebt_set_vebt'_valid valid_pres_insert by blast
fun insert'::"VEBT ⇒ nat ⇒ VEBT" where
"insert' (Leaf a b) x = vebt_insert (Leaf a b) x"|
"insert' (Node info deg treeList summary) x =
(if x ≥ 2^deg then (Node info deg treeList summary )
else vebt_insert (Node info deg treeList summary) x)"
theorem insert'_pres_valid: assumes "invar_vebt t n" shows "invar_vebt (insert' t x) n"
using assms
apply cases
apply (metis One_nat_def deg1Leaf insert'.simps(1) vebt_insert.simps(1))
apply (metis assms insert'.simps(2) leI valid_pres_insert)+
done
theorem insert'_correct: assumes "invar_vebt t n"
shows "set_vebt (insert' t x) = (set_vebt t ∪ {x})∩{0..2^n-1}"
proof(cases t)
case (Node x11 x12 x13 x14)
then show ?thesis
proof(cases "x < 2^n")
case True
hence "set_vebt (insert' t x) = set_vebt(vebt_insert t x)"
by (metis Node assms deg_deg_n insert'.simps(2) leD)
moreover hence "set_vebt(vebt_insert t x) = set_vebt t ∪ {x}"
using True assms insert_correct by auto
moreover hence "set_vebt t ∪ {x} = (set_vebt t ∪ {x})∩{0..2^n-1} "
by (metis Diff_Diff_Int True assms calculation(1) inf_le1 inrange le_inf_iff order_refl subset_antisym set_vebt'_def set_vebt_def set_vebt_set_vebt'_valid valid_pres_insert)
ultimately show ?thesis by simp
next
case False
hence "set_vebt (insert' t x) = set_vebt t"
by (metis Node assms deg_deg_n insert'.simps(2) leI)
moreover hence "set_vebt t = (set_vebt t ∪ {x})∩{0..2^n-1} "
by (smt (z3) False Int_commute Int_insert_right_if0 Un_Int_assoc_eq assms atLeastAtMost_iff boolean_algebra_cancel.sup0 inf_bot_right inrange le_add_diff_inverse le_imp_less_Suc one_le_numeral one_le_power plus_1_eq_Suc sup_commute set_vebt_set_vebt'_valid)
ultimately show ?thesis by simp
qed
next
case (Leaf x21 x22)
then show ?thesis
apply(auto simp add: insert'.simps vebt_insert.simps set_vebt_def both_member_options_def)
using assms
apply cases
apply simp+
using assms
apply cases
apply simp+
using assms
apply cases
apply simp+
using assms
apply cases
apply simp+
done
qed
end
end
Theory VEBT_MinMax
theory VEBT_MinMax imports VEBT_Member
begin
section ‹The Minimum and Maximum Operation›
fun vebt_mint :: "VEBT ⇒ nat option" where
"vebt_mint (Leaf a b) = (if a then Some 0 else if b then Some 1 else None)"|
"vebt_mint (Node None _ _ _) = None"|
"vebt_mint (Node (Some (mi,ma)) _ _ _ ) = Some mi"
fun vebt_maxt :: "VEBT ⇒ nat option" where
"vebt_maxt (Leaf a b) = (if b then Some 1 else if a then Some 0 else None)"|
"vebt_maxt (Node None _ _ _) = None"|
"vebt_maxt (Node (Some (mi,ma)) _ _ _ ) = Some ma"
context VEBT_internal begin
fun option_shift::"('a⇒'a⇒'a) ⇒'a option ⇒'a option⇒ 'a option" where
"option_shift _ None _ = None"|
"option_shift _ _ None = None"|
"option_shift f (Some a) (Some b) = Some (f a b)"
definition power::"nat option ⇒ nat option ⇒ nat option" (infixl"^⇩o" 81) where
"power= option_shift (^)"
definition add::"nat option ⇒ nat option ⇒ nat option" (infixl"+⇩o" 79) where
"add= option_shift (+)"
definition mul::"nat option ⇒ nat option ⇒ nat option" (infixl"*⇩o" 80) where
"mul = option_shift (*)"
fun option_comp_shift::"('a ⇒ 'a ⇒ bool) ⇒ 'a option ⇒ 'a option ⇒ bool" where
"option_comp_shift _ None _ = False"|
"option_comp_shift _ _ None = False"|
"option_comp_shift f (Some x) (Some y) = f x y"
fun less::"nat option ⇒ nat option ⇒ bool" (infixl"<⇩o" 80) where
"less x y= option_comp_shift (<) x y"
fun lesseq::"nat option ⇒ nat option ⇒ bool" (infixl"≤⇩o" 80) where
"lesseq x y = option_comp_shift (≤) x y"
fun greater::"nat option ⇒ nat option ⇒ bool" (infixl">⇩o" 80) where
"greater x y = option_comp_shift (>) x y"
lemma add_shift:"x+y = z ⟷ Some x +⇩o Some y = Some z"
by (simp add: add_def)
lemma mul_shift:"x*y = z ⟷ Some x *⇩o Some y = Some z" by (simp add: mul_def)
lemma power_shift:"x^y = z ⟷ Some x ^⇩o Some y = Some z" by (simp add: power_def)
lemma less_shift: "x < y ⟷ Some x <⇩o Some y" by simp
lemma lesseq_shift: "x ≤ y ⟷ Some x ≤⇩o Some y" by simp
lemma greater_shift: "x > y ⟷ Some x >⇩o Some y" by simp
definition max_in_set :: "nat set ⇒ nat ⇒ bool" where
"max_in_set xs x ⟷ (x ∈ xs ∧ (∀ y ∈ xs. y ≤ x))"
lemma maxt_member: "invar_vebt t n ⟹ vebt_maxt t = Some maxi ⟹ vebt_member t maxi"
proof(induction t n arbitrary: maxi rule: invar_vebt.induct)
case (1 a b)
then show ?case
by (metis VEBT_Member.vebt_member.simps(1) vebt_maxt.simps(1) option.distinct(1) option.inject zero_neq_one)
next
case (2 treeList n summary m deg)
then show ?case
by simp
next
case (3 treeList n summary m deg)
then show ?case
by simp
next
case (4 treeList n summary m deg mi ma)
hence "deg ≥ 2"
by (metis One_nat_def Suc_le_eq add_mono deg_not_0 numeral_2_eq_2 plus_1_eq_Suc)
then show ?case
by (metis "4.prems" VEBT_Member.vebt_member.simps(5) Suc_diff_Suc Suc_pred lessI less_le_trans vebt_maxt.simps(3) numeral_2_eq_2 option.inject zero_less_Suc)
next
case (5 treeList n summary m deg mi ma)
hence "deg ≥ 2"
by (metis Suc_leI le_add2 less_add_same_cancel2 less_le_trans not_less_iff_gr_or_eq not_one_le_zero numeral_2_eq_2 plus_1_eq_Suc set_n_deg_not_0)
then show ?case
by (metis "5.prems" VEBT_Member.vebt_member.simps(5) add_2_eq_Suc le_add_diff_inverse vebt_maxt.simps(3) option.inject)
qed
lemma maxt_corr_help: "invar_vebt t n ⟹ vebt_maxt t = Some maxi ⟹ vebt_member t x ⟹ maxi ≥ x "
by (smt VEBT_Member.vebt_member.simps(1) le_less vebt_maxt.elims member_inv mi_ma_2_deg option.simps(1) option.simps(3) zero_le_one)
lemma maxt_corr_help_empty: "invar_vebt t n ⟹ vebt_maxt t = None ⟹ set_vebt' t = {}"
by (metis (full_types) VEBT_Member.vebt_member.simps(1) empty_Collect_eq vebt_maxt.elims minNull.simps(4) min_Null_member option.distinct(1) set_vebt'_def)
theorem maxt_corr:assumes "invar_vebt t n" and "vebt_maxt t = Some x" shows "max_in_set (set_vebt' t) x"
unfolding set_vebt'_def Max_def max_in_set_def
using assms(1) assms(2) maxt_corr_help maxt_member by blast
theorem maxt_sound:assumes "invar_vebt t n" and "max_in_set (set_vebt' t) x" shows "vebt_maxt t = Some x"
by (metis (no_types, hide_lams) assms(1) assms(2) empty_Collect_eq le_less max_in_set_def
maxt_corr_help maxt_corr_help_empty maxt_member mem_Collect_eq not_le option.exhaust set_vebt'_def)
definition min_in_set :: "nat set ⇒ nat ⇒ bool" where
"min_in_set xs x ⟷ (x ∈ xs ∧ (∀ y ∈ xs. y ≥ x))"
lemma mint_member: "invar_vebt t n ⟹ vebt_mint t = Some maxi ⟹ vebt_member t maxi"
proof(induction t n arbitrary: maxi rule: invar_vebt.induct)
case (1 a b)
then show ?case
by (metis VEBT_Member.vebt_member.simps(1) vebt_mint.simps(1) option.distinct(1) option.inject zero_neq_one)
next
case (2 treeList n summary m deg)
then show ?case
by simp
next
case (3 treeList n summary m deg)
then show ?case
by simp
next
case (4 treeList n summary m deg mi ma)
hence "deg ≥ 2"
by (metis One_nat_def Suc_le_eq add_mono deg_not_0 numeral_2_eq_2 plus_1_eq_Suc)
then show ?case
by (metis "4.prems" VEBT_Member.vebt_member.simps(5) One_nat_def Suc_diff_Suc Suc_pred dual_order.strict_trans1 le_imp_less_Suc le_numeral_extra(4) vebt_mint.simps(3) numeral_2_eq_2 option.inject zero_le_one)
next
case (5 treeList n summary m deg mi ma)
hence "deg ≥ 2"
by (metis Suc_leI le_add2 less_add_same_cancel2 less_le_trans not_less_iff_gr_or_eq not_one_le_zero numeral_2_eq_2 plus_1_eq_Suc set_n_deg_not_0)
then show ?case using "5.prems" VEBT_Member.vebt_member.simps(5) add_2_eq_Suc le_add_diff_inverse vebt_mint.simps(3)
by (metis option.inject)
qed
lemma mint_corr_help: "invar_vebt t n ⟹ vebt_mint t = Some mini ⟹ vebt_member t x ⟹ mini ≤ x "
by (smt VEBT_Member.vebt_member.simps(1) eq_iff option.inject less_imp_le_nat member_inv mi_ma_2_deg vebt_mint.elims of_nat_0 of_nat_0_le_iff of_nat_le_iff option.simps(3))
lemma mint_corr_help_empty: "invar_vebt t n ⟹ vebt_mint t = None ⟹ set_vebt' t = {}"
by (metis VEBT_internal.maxt_corr_help_empty option.distinct(1) vebt_maxt.simps(1) vebt_maxt.simps(2) vebt_mint.elims)
theorem mint_corr:assumes "invar_vebt t n" and "vebt_mint t = Some x" shows "min_in_set (set_vebt' t) x"
using assms(1) assms(2) min_in_set_def mint_corr_help mint_member set_vebt'_def by auto
theorem mint_sound:assumes "invar_vebt t n" and "min_in_set (set_vebt' t) x" shows "vebt_mint t = Some x"
by (metis assms(1) assms(2) empty_Collect_eq eq_iff mem_Collect_eq min_in_set_def
mint_corr_help mint_corr_help_empty mint_member option.exhaust set_vebt'_def)
lemma summaxma:assumes "invar_vebt (Node (Some (mi, ma)) deg treeList summary) deg" and "mi ≠ ma"
shows "the (vebt_maxt summary) = high ma (deg div 2)"
proof-
from assms(1) show ?thesis
proof(cases)
case (4 n m)
have "both_member_options summary (high ma n)"
using "4"(10) "4"(2) "4"(4) "4"(5) "4"(6) "4"(9) assms(2) deg_not_0 exp_split_high_low(1) by blast
have "high ma n ≤ the (vebt_maxt summary)" using "4"(2) ‹both_member_options summary
(high ma n)› empty_Collect_eq option.inject maxt_corr_help maxt_corr_help_empty
not_None_eq set_vebt'_def valid_member_both_member_options
by (metis option.exhaust_sel)
have "high ma n < the (vebt_maxt summary) ⟹ False"
proof-
assume "high ma n < the (vebt_maxt summary)"
obtain maxs where "Some maxs = vebt_maxt summary"
by (metis "4"(2) ‹both_member_options summary (high ma n)› empty_Collect_eq maxt_corr_help_empty
not_None_eq set_vebt'_def valid_member_both_member_options)
hence "∃ x. both_member_options (treeList ! maxs) x"
by (metis "4"(2) "4"(6) both_member_options_equiv_member maxt_member member_bound)
then obtain x where "both_member_options (treeList ! maxs) x"
by auto
hence "vebt_member (treeList ! maxs) x"
by (metis "4"(1) "4"(2) "4"(3) ‹Some maxs = vebt_maxt summary› maxt_member member_bound nth_mem valid_member_both_member_options)
have "maxs < 2^m"
by (metis "4"(2) ‹Some maxs = vebt_maxt summary› maxt_member member_bound)
have "invar_vebt (treeList ! maxs) n"
by (metis "4"(1) "4"(3) ‹maxs < 2 ^ m› inthall member_def)
hence "x < 2^n"
using ‹vebt_member (treeList ! maxs) x› member_bound by auto
let ?X = "2^n*maxs + x"
have "high ?X n = maxs"
by (simp add: ‹x < 2 ^ n› high_inv mult.commute)
hence "both_member_options (Node (Some (mi, ma)) deg treeList summary) (2^n*maxs + x)"
by (metis "4"(3) "4"(4) "4"(5) One_nat_def Suc_leI ‹both_member_options (treeList ! maxs) x› ‹maxs < 2 ^ m› ‹x < 2 ^ n› add_self_div_2 assms(1) both_member_options_from_chilf_to_complete_tree deg_not_0 low_inv mult.commute)
hence "vebt_member (Node (Some (mi, ma)) deg treeList summary) ?X"
using assms(1) both_member_options_equiv_member by auto
have "high ?X n> high ma n"
by (metis ‹Some maxs = vebt_maxt summary› ‹high (2 ^ n * maxs + x) n = maxs› ‹high ma n < the (vebt_maxt summary)› option.exhaust_sel option.inject option.simps(3))
hence "?X > ma"
by (metis div_le_mono high_def not_le)
then show ?thesis
by (metis "4"(8) ‹vebt_member (Node (Some (mi, ma)) deg treeList summary) (2 ^ n * maxs + x)› leD member_inv not_less_iff_gr_or_eq)
qed
then show ?thesis
using "4"(4) "4"(5) ‹high ma n ≤ the (vebt_maxt summary)› by fastforce
next
case (5 n m)
have "both_member_options summary (high ma n)"
by (metis "5"(10) "5"(5) "5"(6) "5"(9) Euclidean_Division.div_eq_0_iff assms(2) div_exp_eq high_def nat.simps(3) numerals(2) power_not_zero)
have "high ma n ≤ the (vebt_maxt summary)"
by (metis "5"(2) VEBT_Member.vebt_member.simps(2) ‹both_member_options summary (high ma n)› vebt_maxt.elims maxt_corr_help minNull.simps(1) min_Null_member option.exhaust_sel option.simps(3) valid_member_both_member_options)
have "high ma n < the (vebt_maxt summary) ⟹ False"
proof-
assume "high ma n < the (vebt_maxt summary)"
obtain maxs where "Some maxs = vebt_maxt summary"
by (metis "5"(2) ‹both_member_options summary (high ma n)› empty_Collect_eq maxt_corr_help_empty
not_None_eq set_vebt'_def valid_member_both_member_options)
hence "∃ x. both_member_options (treeList ! maxs) x"
by (metis "5"(2) "5"(6) both_member_options_equiv_member maxt_member member_bound)
then obtain x where "both_member_options (treeList ! maxs) x"
by auto
hence "vebt_member (treeList ! maxs) x"
by (metis "5"(1) "5"(2) "5"(3) ‹Some maxs = vebt_maxt summary› both_member_options_equiv_member maxt_member member_bound nth_mem)
have "maxs < 2^m"
by (metis "5"(2) ‹Some maxs = vebt_maxt summary› maxt_member member_bound)
have "invar_vebt (treeList ! maxs) n"
by (metis "5"(1) "5"(3) ‹maxs < 2 ^ m› inthall member_def)
hence "x < 2^n"
using ‹vebt_member (treeList ! maxs) x› member_bound by auto
let ?X = "2^n*maxs + x"
have "high ?X n = maxs"
by (simp add: ‹x < 2 ^ n› high_inv mult.commute)
hence "both_member_options (Node (Some (mi, ma)) deg treeList summary) (2^n*maxs + x)"
by (smt (z3) "5"(3) "5"(4) "5"(5) ‹both_member_options (treeList ! maxs) x› ‹maxs < 2 ^ m› ‹x < 2 ^ n› add_Suc_right add_self_div_2 both_member_options_from_chilf_to_complete_tree even_Suc_div_two le_add1 low_inv mult.commute odd_add plus_1_eq_Suc)
hence "vebt_member (Node (Some (mi, ma)) deg treeList summary) ?X"
using assms(1) both_member_options_equiv_member by auto
have "high ?X n> high ma n"
by (metis ‹Some maxs = vebt_maxt summary› ‹high (2 ^ n * maxs + x) n = maxs› ‹high ma n < the (vebt_maxt summary)› option.sel)
hence "?X > ma"
by (metis div_le_mono high_def not_le)
then show ?thesis
by (metis "5"(8) ‹vebt_member (Node (Some (mi, ma)) deg treeList summary) (2 ^ n * maxs + x)› leD member_inv not_less_iff_gr_or_eq)
qed
then show ?thesis
using "5"(4) "5"(5) ‹high ma n ≤ the(vebt_maxt summary)› by fastforce
qed
qed
lemma maxbmo: "vebt_maxt t = Some x ⟹ both_member_options t x"
apply(induction t rule: vebt_maxt.induct)
apply auto
apply (metis both_member_options_def naive_member.simps(1) option.distinct(1) option.sel zero_neq_one)
by (metis One_nat_def Suc_le_D both_member_options_def div_by_1 div_greater_zero_iff membermima.simps(3) membermima.simps(4) not_gr0)
lemma misiz:"invar_vebt t n ⟹ Some m = vebt_mint t ⟹ m < 2^n"
by (metis member_bound mint_member)
lemma mintlistlength: assumes "invar_vebt (Node (Some (mi, ma)) deg treeList summary) n " "
mi ≠ ma " shows " ma > mi ∧ (∃ m. Some m = vebt_mint summary ∧ m < 2^(n - n div 2))"
using assms(1)
proof cases
case (4 n m)
hence "both_member_options (treeList ! high ma n) (low ma n)"
by (metis assms(2) high_bound_aux)
moreover hence "both_member_options summary (high ma n)"
using "4"(10) "4"(6) "4"(7) high_bound_aux by blast
moreover then obtain mini where "Some mini = vebt_mint summary"
by (metis "4"(3) empty_Collect_eq mint_corr_help_empty option.exhaust_sel set_vebt'_def valid_member_both_member_options)
moreover hence "mini < 2^m"
by (metis "4"(3) mint_member member_bound)
moreover have "m = (deg - deg div 2)" using 4(6) 4(5)
by auto
ultimately show ?thesis using 4(1) assms 4(9) by auto
next
case (5 n m)
hence "both_member_options (treeList ! high ma n) (low ma n)"
by (metis assms(2) high_bound_aux)
moreover hence "both_member_options summary (high ma n)"
using "5"(10) "5"(6) "5"(7) high_bound_aux by blast
moreover then obtain mini where "Some mini = vebt_mint summary"
by (metis "5"(3) empty_Collect_eq mint_corr_help_empty option.exhaust_sel set_vebt'_def valid_member_both_member_options)
moreover hence "mini < 2^m"
by (metis "5"(3) mint_member member_bound)
moreover have "m = (deg - deg div 2)" using 5(6) 5(5)
by auto
ultimately show ?thesis using 5(1) assms 5(9) by auto
qed
lemma power_minus_is_div:
"b ≤ a ⟹ (2 :: nat) ^ (a - b) = 2 ^ a div 2 ^ b"
apply (induct a arbitrary: b)
apply simp
apply (erule le_SucE)
apply (clarsimp simp:Suc_diff_le le_iff_add power_add)
apply simp
done
lemma nested_mint:assumes "invar_vebt (Node (Some (mi, ma)) deg treeList summary) n " "n = Suc (Suc va) ""
¬ ma < mi "" ma ≠ mi " shows "
high (the (vebt_mint summary) * (2 * 2 ^ (va div 2)) + the (vebt_mint (treeList ! the (vebt_mint summary)))) (Suc (va div 2))
< length treeList"
proof-
have setprop: "t ∈ set treeList ⟹ invar_vebt t (n div 2 )" for t using assms(1)
by (cases) simp+
have listlength: "length treeList = 2^(n - n div 2)" using assms(1)
by (cases) simp+
have sumprop: "invar_vebt summary (n - n div 2)" using assms(1)
by (cases) simp+
have mimaxprop: "mi ≤ ma ∧ ma ≤ 2^n" using assms(1)
by cases simp+
hence xbound: "mi ≤ x ⟹ x ≤ ma ⟹ high x (n div 2) ≤ length treeList " for x
using div_le_dividend div_le_mono high_def listlength power_minus_is_div by auto
have contcong:"i < length treeList ⟹ ∃ x. both_member_options (treeList ! i) x ⟷ both_member_options summary i " for i
using assms(1)by cases auto+
obtain m where " Some m = vebt_mint summary ∧ m < 2^(n - n div 2)"
using assms(1) assms(4) mintlistlength by blast
then obtain miny where "(vebt_mint (treeList ! the (vebt_mint summary))) =Some miny"
by (metis both_member_options_equiv_member contcong empty_Collect_eq listlength mint_corr_help_empty mint_member nth_mem option.exhaust_sel option.sel setprop sumprop set_vebt'_def)
hence "miny < 2^(n div 2)"
by (metis ‹⋀thesis. (⋀m. Some m = vebt_mint summary ∧ m < 2 ^ (n - n div 2) ⟹ thesis) ⟹ thesis› listlength misiz nth_mem option.sel setprop)
then show ?thesis
by (metis ‹⋀thesis. (⋀m. Some m = vebt_mint summary ∧ m < 2 ^ (n - n div 2) ⟹ thesis) ⟹ thesis› ‹vebt_mint (treeList ! the (vebt_mint summary)) = Some miny› assms(2) div2_Suc_Suc high_inv listlength option.sel power_Suc)
qed
lemma minminNull: "vebt_mint t = None ⟹ minNull t"
by (metis minNull.simps(1) minNull.simps(4) vebt_mint.elims option.distinct(1))
lemma minNullmin: "minNull t ⟹ vebt_mint t = None"
by (metis minNull.elims(2) vebt_mint.simps(1) vebt_mint.simps(2))
end
end
Theory VEBT_Succ
theory VEBT_Succ imports VEBT_Insert VEBT_MinMax
begin
section ‹The Successor Operation›
definition is_succ_in_set :: "nat set ⇒ nat ⇒ nat ⇒ bool" where
"is_succ_in_set xs x y = (y ∈ xs ∧ y > x ∧ (∀ z ∈ xs. (z > x ⟶ z ≥ y)))"
context VEBT_internal begin
corollary succ_member: "is_succ_in_set (set_vebt' t) x y = (vebt_member t y ∧ y > x ∧ (∀ z. vebt_member t z ∧ z > x ⟶ z ≥ y))"
using is_succ_in_set_def set_vebt'_def by auto
subsection ‹Auxiliary Lemmas on Sets and Successorship›
lemma "finite (A:: nat set) ⟹ A ≠ {}⟹ Min A ∈ A"
by(induction A rule: finite.induct)(blast | meson Min_in finite_insert)+
lemma obtain_set_succ: assumes "(x::nat) < z " and "max_in_set A z" and "finite B" and "A=B" shows "∃ y. is_succ_in_set A x y"
proof-
have "{y ∈ A. y > x} ≠ {}"
using assms(1) assms(2) max_in_set_def by auto
have "Min {y ∈ A. y > x} ∈ {y ∈ A. y > x}"
by (metis (full_types) Collect_mem_eq ‹{y ∈ A. x < y} ≠ {}› assms(3) assms(4) eq_Min_iff finite_Collect_conjI)
have "i ∈ A⟹ i > x ⟹ i ≥ Min {y ∈ A. y > x} " for i
by (simp add: assms(3) assms(4))
have "is_succ_in_set A x (Min {y ∈ A. y > x})"
using is_succ_in_set_def ‹Min {y ∈ A. x < y} ∈ {y ∈ A. x < y}› ‹⋀i. ⟦i ∈ A; x < i⟧ ⟹ Min {y ∈ A. x < y} ≤ i› by blast
then show?thesis by auto
qed
lemma succ_none_empty: assumes "(∄ x. is_succ_in_set (xs) a x)" and "finite xs"shows "¬ (∃ x ∈ xs. ord_class.greater x a)"
proof-
have "∃ x ∈ xs. ord_class.greater x a ⟹ False"
proof-
assume "∃ x ∈ xs. ord_class.greater x a"
hence "{x ∈ xs. ord_class.greater x a} ≠ {}" by auto
have "Min {y ∈ xs. y > a} ∈ {y ∈ xs. y > a}"
by (metis (full_types) Collect_mem_eq Min_in ‹{x ∈ xs. a < x} ≠ {}› assms(2) finite_Collect_conjI)
have "i ∈ xs ⟹ ord_class.greater i a⟹
ord_class.greater_eq i (Min {y ∈ xs. ord_class.greater y a}) " for i
by (simp add: assms(2))
have "is_succ_in_set xs a (Min {y ∈ xs. y > a})"
using is_succ_in_set_def ‹Min {y ∈ xs. a < y} ∈ {y ∈ xs. a < y}› ‹⋀i. ⟦i ∈ xs; a < i⟧ ⟹ Min {y ∈ xs. a < y} ≤ i› by blast
then show False
using assms(1) by blast
qed
then show ?thesis by blast
qed
end
subsection ‹The actual Function›
context begin
interpretation VEBT_internal .
fun vebt_succ :: "VEBT ⇒ nat ⇒ nat option" where
"vebt_succ (Leaf _ b) 0 = (if b then Some 1 else None)"|
"vebt_succ (Leaf _ _) (Suc n) = None"|
"vebt_succ (Node None _ _ _) _ = None"|
"vebt_succ (Node _ 0 _ _) _ = None"|
"vebt_succ (Node _ (Suc 0) _ _) _ = None"|
"vebt_succ (Node (Some (mi, ma)) deg treeList summary) x = (
if x < mi then (Some mi)
else (let l = low x (deg div 2); h = high x (deg div 2) in
if h < length treeList then
let maxlow = vebt_maxt (treeList ! h) in (
if maxlow ≠ None ∧ (Some l <⇩o maxlow) then
Some (2^(deg div 2)) *⇩o Some h +⇩o vebt_succ (treeList ! h) l
else let sc = vebt_succ summary h in
if sc = None then None
else Some (2^(deg div 2)) *⇩o sc +⇩o vebt_mint (treeList ! the sc) )
else None))"
end
subsection ‹Lemmas for Term Decomposition›
context VEBT_internal begin
lemma succ_min: assumes "deg ≥ 2" and "(x::nat) < mi" shows
"vebt_succ (Node (Some (mi, ma)) deg treeList summary) x = Some mi"
by (metis add_2_eq_Suc assms(1) assms(2) le_add_diff_inverse vebt_succ.simps(6))
lemma succ_greatereq_min: assumes "deg ≥ 2" and "(x::nat) ≥ mi" shows
"vebt_succ (Node (Some (mi, ma)) deg treeList summary) x = (let l = low x (deg div 2); h = high x (deg div 2) in
if h < length treeList then
let maxlow = vebt_maxt (treeList ! h) in
(if maxlow ≠ None ∧ (Some l <⇩o maxlow) then
Some (2^(deg div 2)) *⇩o Some h +⇩o vebt_succ (treeList ! h) l
else let sc = vebt_succ summary h in
if sc = None then None
else Some (2^(deg div 2)) *⇩o sc +⇩o vebt_mint (treeList ! the sc) )
else None)"
by (smt add_numeral_left arith_simps(1) assms(1) assms(2) le_add_diff_inverse not_less numerals(1) plus_1_eq_Suc vebt_succ.simps(6))
lemma succ_list_to_short: assumes "deg ≥ 2" and "x ≥ mi" and " high x (deg div 2) ≥ length treeList" shows
"vebt_succ (Node (Some (mi, ma)) deg treeList summary) x = None"
using assms(1) assms(2) assms(3) succ_greatereq_min by auto
lemma succ_less_length_list: assumes "deg ≥ 2" and "x ≥ mi" and " high x (deg div 2) < length treeList" shows
"vebt_succ (Node (Some (mi, ma)) deg treeList summary) x =
(let l = low x (deg div 2); h = high x (deg div 2) ; maxlow = vebt_maxt (treeList ! h) in
(if maxlow ≠ None ∧ (Some l <⇩o maxlow) then
Some (2^(deg div 2)) *⇩o Some h +⇩o vebt_succ (treeList ! h) l
else let sc = vebt_succ summary h in
if sc = None then None
else Some (2^(deg div 2)) *⇩o sc +⇩o vebt_mint (treeList !the sc)))"
by (simp add: assms(1) assms(2) assms(3) succ_greatereq_min)
subsection ‹Correctness Proof›
theorem succ_corr: "invar_vebt t n ⟹ vebt_succ t x = Some sx == is_succ_in_set (set_vebt' t) x sx"
proof(induction t n arbitrary: x sx rule: invar_vebt.induct)
case (1 a b)
then show ?case proof(cases x)
case 0
then show ?thesis
by (simp add: succ_member)
next
case (Suc nat)
then show ?thesis proof(cases nat)
case 0
then show ?thesis
by (simp add: Suc succ_member)
next
case (Suc nat)
then show ?thesis by (metis (no_types) VEBT_Member.vebt_member.simps(1) Suc_eq_plus1 add_cancel_right_left le_add2 le_imp_less_Suc not_add_less2 not_less0 old.nat.exhaust option.distinct(1) option.simps(1) vebt_succ.simps(1) vebt_succ.simps(2) succ_member)
qed
qed
next
case (2 treeList n summary m deg)
then show ?case
by (simp add: succ_member)
next
case (3 treeList n summary m deg)
then show ?case
by (simp add: succ_member)
next
case (4 treeList n summary m deg mi ma)
hence "n = m" and "n ≥ 1" and "deg ≥ 2" and "deg = n + m"
apply blast+
using "4.hyps"(2) "4.hyps"(5) Suc_le_eq deg_not_0 apply auto[1]
using "4.hyps"(2) "4.hyps"(5) "4.hyps"(6) deg_not_0 apply fastforce
by (simp add: "4.hyps"(6))
hence "deg div 2 =n" and "length treeList = 2^n"
using add_self_div_2 apply blast by (simp add: "4.hyps"(4) "4.hyps"(5))
then show ?case proof(cases "x < mi")
case True
hence 0: "vebt_succ (Node (Some (mi, ma)) deg treeList summary) x = Some mi"
by (simp add: ‹2 ≤ deg› succ_min)
have 1:"mi = the (vebt_mint (Node (Some (mi, ma)) deg treeList summary))" by simp
hence "mi ∈ set_vebt' (Node (Some (mi, ma)) deg treeList summary)"
by (metis VEBT_Member.vebt_member.simps(5) ‹2 ≤ deg› add_numeral_left arith_simps(1) le_add_diff_inverse mem_Collect_eq numerals(1) plus_1_eq_Suc set_vebt'_def)
hence 2:"y ∈ set_vebt' (Node (Some (mi, ma)) deg treeList summary) ⟹ y ≥ x" for y
using "4.hyps"(9) True member_inv set_vebt'_def by fastforce
hence 3: "y ∈ set_vebt' (Node (Some (mi, ma)) deg treeList summary) ⟹ (y > mi ⟹ y ≥ x)" for y by blast
hence 4: "∀ y ∈ set_vebt' (Node (Some (mi, ma)) deg treeList summary). y > mi ⟶ y ≥ x" by blast
hence "is_succ_in_set (set_vebt' (Node (Some (mi, ma)) deg treeList summary)) x mi"
by (metis (mono_tags, lifting) "4.hyps"(9) True ‹mi ∈ set_vebt' (Node (Some (mi, ma)) deg treeList summary)› eq_iff less_imp_le_nat mem_Collect_eq member_inv succ_member set_vebt'_def)
then show ?thesis using 0
by (metis is_succ_in_set_def antisym_conv option.inject)
next
case False
hence "x ≥ mi"by simp
then show ?thesis
proof(cases "high x (deg div 2)< length treeList ")
case True
hence "high x n < 2^n ∧ low x n < 2^n"
by (simp add: ‹deg div 2 = n› ‹length treeList = 2 ^ n› low_def)
let ?l = "low x (deg div 2)"
let ?h = "high x (deg div 2)"
let ?maxlow = "vebt_maxt (treeList ! ?h)"
let ?sc = "vebt_succ summary ?h"
have 1:"vebt_succ (Node (Some (mi, ma)) deg treeList summary) x =
(if ?maxlow ≠ None ∧ (Some ?l <⇩o ?maxlow) then
Some (2^(deg div 2)) *⇩o Some ?h +⇩o vebt_succ (treeList ! ?h) ?l
else if ?sc = None then None
else Some (2^(deg div 2)) *⇩o ?sc +⇩o vebt_mint (treeList ! the ?sc))"
by (smt True ‹2 ≤ deg› ‹mi ≤ x› succ_less_length_list)
then show ?thesis
proof(cases "?maxlow ≠ None ∧ (Some ?l <⇩o ?maxlow)")
case True
then obtain maxl where 00:"Some maxl = ?maxlow ∧ ?l < maxl" by auto
have 01:"invar_vebt ((treeList ! ?h)) n ∧ (treeList ! ?h) ∈ set treeList "
by (simp add: "4.hyps"(1) ‹deg div 2 = n› ‹high x n < 2 ^ n ∧ low x n < 2 ^ n› ‹length treeList = 2 ^ n›)
have 02:"vebt_member ((treeList ! ?h)) maxl"
using "00" "01" maxt_member by auto
hence 03: "∃ y. y > ?l ∧ vebt_member ((treeList ! ?h)) y"
using "00" by blast
hence afinite: "finite (set_vebt' (treeList ! ?h)) "
using "01" set_vebt_finite by blast
then obtain succy where 04:"is_succ_in_set (set_vebt' (treeList ! ?h)) ?l succy"
using "00" "01" maxt_corr obtain_set_succ by fastforce
hence 05:"Some succy = vebt_succ (treeList ! ?h) ?l" using 4(1) 01 by force
hence "vebt_succ (Node (Some (mi, ma)) deg treeList summary) x = Some (2^(deg div 2)* ?h + succy) "
by (metis "1" True add_def mul_def option_shift.simps(3))
hence 06: "succy ∈ set_vebt' (treeList ! ?h)"
using "04" is_succ_in_set_def by blast
hence 07: "succy < 2^(deg div 2) ∧ ?h < 2^(deg div 2) ∧ deg div 2 + deg div 2 = deg"
using "01" "04" "4.hyps"(5) "4.hyps"(6) ‹high x n < 2 ^ n ∧ low x n < 2 ^ n› member_bound succ_member by auto
let ?y = "2^(deg div 2)* ?h + succy"
have 08: "vebt_member (treeList ! ?h) succy"
using "06" set_vebt'_def by auto
hence 09: "both_member_options (treeList ! ?h) succy"
using "01" both_member_options_equiv_member by blast
have 10: "high ?y (deg div 2) = ?h ∧ low ?y (deg div 2) = succy"
by (simp add: "07" high_inv low_inv mult.commute)
hence 11: "naive_member (treeList ! ?h) succy
⟹ naive_member (Node (Some (mi, ma)) deg treeList summary) ?y"
using naive_member.simps(3)[of "Some (mi, ma)" "deg-1" treeList summary ?y]
by (metis "07" "4.hyps"(4) "4.hyps"(5) One_nat_def Suc_pred ‹2 ≤ deg› ‹deg div 2 = n› add_gr_0 div_greater_zero_iff zero_less_numeral)
have 12: "?y ≥ mi ∧ ?y ≤ ma"
by (metis "01" "07" "09" "10" "4.hyps"(11) "4.hyps"(5) "4.hyps"(8) ‹deg div 2 = n› less_imp_le_nat)
hence 13: "membermima (treeList ! ?h) succy
⟹ membermima (Node (Some (mi, ma)) deg treeList summary) ?y"
using membermima.simps(4)[of mi ma "deg -1" treeList summary ?y]
apply(cases "?y = mi ∨ ?y = ma")
apply (metis "07" One_nat_def Suc_pred ‹2 ≤ deg› add_gr_0 div_greater_zero_iff zero_less_numeral)
by (metis "07" "10" "4.hyps"(4) "4.hyps"(5) One_nat_def Suc_pred ‹2 ≤ deg› ‹deg div 2 = n› add_gr_0 div_greater_zero_iff zero_less_numeral)
hence 14:"both_member_options (Node (Some (mi, ma)) deg treeList summary) ?y"
using "09" "11" both_member_options_def by blast
have 15: "vebt_member (Node (Some (mi, ma)) deg treeList summary) ?y"
by (smt "07" "08" "10" "12" "4.hyps"(4) "4.hyps"(5) VEBT_Member.vebt_member.simps(5) One_nat_def Suc_1 Suc_le_eq Suc_pred ‹2 ≤ deg› ‹deg div 2 = n› add_gr_0 div_greater_zero_iff not_less zero_less_numeral)
have 16: "Some ?y = vebt_succ (Node (Some (mi, ma)) deg treeList summary) x"
by (simp add: ‹vebt_succ (Node (Some (mi, ma)) deg treeList summary) x = Some (2 ^ (deg div 2) * high x (deg div 2) + succy)›)
have 17: "x = ?h * 2^(deg div 2) + ?l"
using bit_concat_def bit_split_inv by auto
have 18: "?y - x = ?h * 2^(deg div 2) + succy - ?h * 2^(deg div 2) - ?l "
by (metis "17" diff_diff_add mult.commute)
hence "?y -x > 0"
using "04" is_succ_in_set_def by auto
hence 19: "?y > x"
using zero_less_diff by blast
have 20: "z > x ⟹ vebt_member (Node (Some (mi, ma)) deg treeList summary) z ⟹ z≥ ?y " for z
proof-
assume "z > x" and "vebt_member (Node (Some (mi, ma)) deg treeList summary) z"
hence "high z (deg div 2) ≥ high x (deg div 2)"
by (simp add: div_le_mono high_def)
then show ?thesis proof(cases "high z (deg div 2) = high x (deg div 2)")
case True
hence "vebt_member (treeList ! ?h) (low z (deg div 2))"
using vebt_member.simps(5)[of mi ma "deg-2" treeList summary z]
by (metis "01" "07" "4.hyps"(11) "4.hyps"(5) False ‹deg div 2 = n› ‹vebt_member (Node (Some (mi, ma)) deg treeList summary) z› ‹x < z› both_member_options_equiv_member member_inv)
hence "succy ≤ low z (deg div 2)" using 04 unfolding is_succ_in_set_def
by (metis True ‹x < z› add_diff_cancel_left' bit_concat_def bit_split_inv diff_diff_left mem_Collect_eq set_vebt'_def zero_less_diff)
hence "?y ≤ z"
by (smt True bit_concat_def bit_split_inv diff_add_inverse diff_diff_add diff_is_0_eq mult.commute)
then show ?thesis by blast
next
case False
hence "high z (deg div 2) > high ?y (deg div 2)"
using "10" ‹high x (deg div 2) ≤ high z (deg div 2)› by linarith
then show ?thesis
by (metis div_le_mono high_def nat_le_linear not_le)
qed
qed
hence "is_succ_in_set (set_vebt' (Node (Some (mi, ma)) deg treeList summary)) x ?y"
by (simp add: "15" "19" succ_member)
then show ?thesis using 16
by (metis eq_iff option.inject succ_member)
next
case False
hence i1:"?maxlow = None ∨ ¬ (Some ?l <⇩o ?maxlow)" by simp
hence 2: "vebt_succ (Node (Some (mi, ma)) deg treeList summary) x = (if ?sc = None then None
else Some (2^(deg div 2)) *⇩o ?sc +⇩o vebt_mint (treeList ! the ?sc))"
using "1" by auto
have " invar_vebt (treeList ! ?h) n"
by (metis "4"(1) True inthall member_def)
hence 33:"∄ u. vebt_member (treeList ! ?h) u ∧ u > ?l"
proof(cases "?maxlow = None")
case True
then show ?thesis using maxt_corr_help_empty[of "treeList ! ?h" n]
by (simp add: ‹invar_vebt (treeList ! high x (deg div 2)) n› set_vebt'_def)
next
case False
obtain maxilow where "?maxlow =Some maxilow"
using False by blast
hence "maxilow ≤ ?l"
using "i1" by auto
then show ?thesis
by (meson ‹vebt_maxt (treeList ! high x (deg div 2)) = Some maxilow› ‹invar_vebt (treeList ! high x (deg div 2)) n› le_imp_less_Suc le_less_trans maxt_corr_help not_less_eq)
qed
then show ?thesis
proof(cases " ?sc = None")
case True
hence "vebt_succ (Node (Some (mi, ma)) deg treeList summary) x = None"
by (simp add: "2")
hence "∄ i. is_succ_in_set (set_vebt' summary) ?h i"
using "4.hyps"(3) True by force
hence "∄ i. i > ?h ∧ vebt_member summary i " using succ_none_empty[of "set_vebt' summary" ?h]
proof -
{ fix nn :: nat
have "∀n. ((is_succ_in_set (Collect (vebt_member summary)) (high x (deg div 2)) esk1_0 ∨ infinite (Collect (vebt_member summary))) ∨ n ∉ Collect (vebt_member summary)) ∨ ¬ high x (deg div 2) < n"
using ‹∄i. is_succ_in_set (set_vebt' summary) (high x (deg div 2)) i› succ_none_empty set_vebt'_def by auto
then have "¬ high x (deg div 2) < nn ∨ ¬ vebt_member summary nn"
using "4.hyps"(2) ‹∄i. is_succ_in_set (set_vebt' summary) (high x (deg div 2)) i› set_vebt'_def set_vebt_finite by auto }
then show ?thesis
by blast
qed
hence "(i > x ∧ vebt_member (Node (Some (mi, ma)) deg treeList summary) i) ⟹ False" for i
proof-
fix i
assume "i > x ∧ vebt_member (Node (Some (mi, ma)) deg treeList summary) i"
hence 20: "i = mi ∨ i = ma ∨ (high i (deg div 2) < length treeList
∧ vebt_member ( treeList ! (high i (deg div 2))) (low i (deg div 2)))" using
vebt_member.simps(5)[of mi ma "deg-2" treeList summary i]
using member_inv by blast
have "i ≠ mi"
using ‹mi ≤ x› ‹x < i ∧ vebt_member (Node (Some (mi, ma)) deg treeList summary) i› not_le by blast
hence "mi ≠ ma"
using ‹x < i ∧ vebt_member (Node (Some (mi, ma)) deg treeList summary) i› member_inv not_less_iff_gr_or_eq by blast
hence "i < 2^deg"
using "4.hyps"(10) ‹i ≠ mi› ‹x < i ∧ vebt_member (Node (Some (mi, ma)) deg treeList summary) i› member_inv by fastforce
hence aa:"i = ma ⟹ both_member_options( treeList ! (high i (deg div 2))) (low i (deg div 2))"
using "4.hyps"(11) "4.hyps"(2) "4.hyps"(5) "4.hyps"(6) ‹mi ≠ ma› deg_not_0 exp_split_high_low(1) by auto
hence abc:"invar_vebt (treeList ! (high i (deg div 2))) n"
by (metis "4.hyps"(1) "4.hyps"(2) "4.hyps"(5) "4.hyps"(6) ‹deg div 2 = n› ‹i < 2 ^ deg› ‹length treeList = 2 ^ n› deg_not_0 exp_split_high_low(1) in_set_member inthall)
hence abd:"i = ma ⟹ vebt_member( treeList ! (high i (deg div 2))) (low i (deg div 2))"
using aa valid_member_both_member_options by blast
hence abe:"vebt_member( treeList ! (high i (deg div 2))) (low i (deg div 2))"
using "20" ‹i ≠ mi› by blast
hence abf:"both_member_options( treeList ! (high i (deg div 2))) (low i (deg div 2))"
using ‹invar_vebt (treeList ! high i (deg div 2)) n› both_member_options_equiv_member by blast
hence abg:"both_member_options summary (high i (deg div 2))"
by (metis "20" "4.hyps"(10) "4.hyps"(2) "4.hyps"(4) "4.hyps"(6) "4.hyps"(7) ‹2 ≤ deg› ‹deg div 2 = n› ‹i ≠ mi› deg_not_0 div_greater_zero_iff exp_split_high_low(1) zero_less_numeral)
hence abh:"vebt_member summary (high i (deg div 2))"
using "4.hyps"(2) valid_member_both_member_options by blast
have aaa:"(high i (deg div 2)) = (high x (deg div 2)) ⟹ vebt_member (treeList ! ?h) (low i (deg div 2))"
using ‹vebt_member (treeList ! high i (deg div 2)) (low i (deg div 2))› by auto
have abi:"(high i (deg div 2)) = (high x (deg div 2)) ⟹ low i (deg div 2) > ?l"
by (metis ‹x < i ∧ vebt_member (Node (Some (mi, ma)) deg treeList summary) i› add_le_cancel_left bit_concat_def bit_split_inv le_neq_implies_less less_imp_le_nat nat_neq_iff)
hence abj:"(high i (deg div 2)) = (high x (deg div 2)) ⟹ False" using 33 aaa by blast
hence abk:" (high i (deg div 2)) ∈ (set_vebt' summary) ∧ (high i (deg div 2)) > (high x (deg div 2)) "
by (metis (full_types) ‹vebt_member summary (high i (deg div 2))› ‹x < i ∧ vebt_member (Node (Some (mi, ma)) deg treeList summary) i› div_le_mono high_def le_less mem_Collect_eq set_vebt'_def)
then show ?thesis
using ‹¬ (∃i>high x (deg div 2). vebt_member summary i)› abh by blast
qed
then show ?thesis
using ‹vebt_succ (Node (Some (mi, ma)) deg treeList summary) x = None› succ_member by auto
next
case False
hence "vebt_succ (Node (Some (mi, ma)) deg treeList summary) x =
Some (2^(deg div 2)) *⇩o ?sc +⇩o vebt_mint (treeList ! the ?sc)"
by (simp add: False "2")
obtain sc where "?sc = Some sc"
using False by blast
hence "is_succ_in_set (set_vebt' summary) ?h sc"
using "4.hyps"(3) by blast
hence "vebt_member summary sc"
using succ_member by blast
hence "both_member_options summary sc"
using "4.hyps"(2) both_member_options_equiv_member by auto
hence "sc < 2^m"
using "4.hyps"(2) ‹vebt_member summary sc› member_bound by blast
hence "∃ miny. both_member_options (treeList ! sc) miny"
using "4.hyps"(7) ‹both_member_options summary sc› by blast
hence fgh:"set_vebt' (treeList ! sc) ≠ {}"
by (metis "4.hyps"(1) "4.hyps"(4) "4.hyps"(5) Collect_empty_eq_bot ‹deg div 2 = n› ‹sc < 2 ^ m› bot_empty_eq empty_iff nth_mem set_vebt'_def valid_member_both_member_options)
hence "invar_vebt (treeList ! the ?sc) n"
by (simp add: "4.hyps"(1) "4.hyps"(4) ‹sc < 2 ^ m› ‹vebt_succ summary (high x (deg div 2)) = Some sc›)
then obtain miny where "Some miny = vebt_mint (treeList ! sc)"
by (metis fgh Collect_empty_eq VEBT_Member.vebt_member.simps(2) vebt_buildup.simps(2) buildup_gives_empty vebt_mint.elims set_vebt'_def)
hence "Some miny = vebt_mint (treeList ! the ?sc)"
by (simp add: ‹vebt_succ summary (high x (deg div 2)) = Some sc›)
hence "min_in_set (set_vebt' (treeList ! the ?sc)) miny"
using ‹invar_vebt (treeList ! the (vebt_succ summary (high x (deg div 2)))) n› mint_corr by auto
hence scmem:"vebt_member (treeList ! the ?sc) miny"
using ‹Some miny = vebt_mint (treeList ! the (vebt_succ summary (high x (deg div 2))))› ‹invar_vebt (treeList ! the(vebt_succ summary (high x (deg div 2)))) n› mint_member by auto
let ?res = "Some (2^(deg div 2)) *⇩o ?sc +⇩o vebt_mint (treeList !the ?sc)"
obtain res where "res = the ?res" by blast
hence "res = 2^(deg div 2) * sc + miny"
by (metis ‹Some miny = vebt_mint (treeList ! the (vebt_succ summary (high x (deg div 2))))› ‹vebt_succ summary (high x (deg div 2)) = Some sc› add_def mul_def option.sel option_shift.simps(3))
have "high res (deg div 2) = sc"
by (metis ‹deg div 2 = n› ‹res = 2 ^ (deg div 2) * sc + miny› ‹invar_vebt (treeList ! the ?sc) n› high_inv member_bound mult.commute scmem)
hence "res > x"
by (metis is_succ_in_set_def ‹is_succ_in_set (set_vebt' summary) (high x (deg div 2)) sc› div_le_mono high_def not_le)
hence "res > mi"
using ‹mi ≤ x› le_less_trans by blast
hence "res ≤ ma"
proof(cases "high res n < high ma n")
case True
then show ?thesis
by (metis div_le_mono high_def leD nat_le_linear)
next
case False
hence "mi ≠ ma"
by (metis "4.hyps"(5) "4.hyps"(8) ‹∃miny. both_member_options (treeList ! sc) miny› ‹length treeList = 2 ^ n› ‹sc < 2 ^ m› nth_mem)
have "high res n < 2^m"
using ‹deg div 2 = n› ‹high res (deg div 2) = sc› ‹sc < 2 ^ m› by blast
hence " (∀x. high x n = high res n ∧ both_member_options (treeList ! (high res n)) (low x n) ⟶ mi < x ∧ x ≤ ma)" using 4(11)
using ‹mi ≠ ma› by blast
have "high res n = high res n ∧ both_member_options (treeList ! (high res n)) (low res n)"
by (metis ‹deg div 2 = n› ‹high res (deg div 2) = sc› ‹res = 2 ^ (deg div 2) * sc + miny› ‹vebt_succ summary (high x (deg div 2)) = Some sc› ‹invar_vebt (treeList ! the (vebt_succ summary (high x (deg div 2)))) n› both_member_options_equiv_member low_inv member_bound mult.commute option.sel scmem)
then show ?thesis
using ‹∀x. high x n = high res n ∧ both_member_options (treeList ! high res n) (low x n) ⟶ mi < x ∧ x ≤ ma› by blast
qed
hence "vebt_member (Node (Some (mi, ma)) deg treeList summary) (the ?res)" using vebt_member.simps(5)[of mi ma "deg-2" treeList summary res]
by (metis "4.hyps"(4) ‹2 ≤ deg› ‹deg div 2 = n› ‹high res (deg div 2) = sc› ‹mi < res› ‹res = 2 ^ (deg div 2) * sc + miny› ‹res = the (Some (2 ^ (deg div 2)) *⇩o vebt_succ summary (high x (deg div 2)) +⇩o vebt_mint (treeList ! the (vebt_succ summary (high x (deg div 2)))))› ‹sc < 2 ^ m› ‹vebt_succ summary (high x (deg div 2)) = Some sc› ‹invar_vebt (treeList ! the (vebt_succ summary (high x (deg div 2)))) n› add_2_eq_Suc leD le_add_diff_inverse low_inv member_bound mult.commute not_less_iff_gr_or_eq option.sel scmem)
have "(vebt_member (Node (Some (mi, ma)) deg treeList summary) z ∧ z > x) ⟹ z ≥ res" for z
proof-
fix z
assume "vebt_member (Node (Some (mi, ma)) deg treeList summary) z ∧ z > x"
hence 20: "z = mi ∨ z = ma ∨ (high z (deg div 2) < length treeList
∧ vebt_member ( treeList ! (high z (deg div 2))) (low z (deg div 2)))" using
vebt_member.simps(5)[of mi ma "deg-2" treeList summary z]
using member_inv by blast
have "z ≠ mi"
using ‹vebt_member (Node (Some (mi, ma)) deg treeList summary) z ∧ x < z› ‹mi ≤ x› not_le by blast
hence "mi ≠ ma"
using ‹mi < res› ‹res ≤ ma› not_le by blast
hence "z < 2^deg"
using "4.hyps"(10) ‹vebt_member (Node (Some (mi, ma)) deg treeList summary) z ∧ x < z› ‹z ≠ mi› member_inv by fastforce
hence aa:"z = ma ⟹ both_member_options( treeList ! (high z (deg div 2))) (low z (deg div 2))"
using "4.hyps"(11) "4.hyps"(2) "4.hyps"(5) "4.hyps"(6) ‹mi ≠ ma› deg_not_0 exp_split_high_low(1) by auto
hence abc:"invar_vebt (treeList ! (high z (deg div 2))) n"
by (metis "4.hyps"(1) "4.hyps"(2) "4.hyps"(5) "4.hyps"(6) ‹deg div 2 = n› ‹z < 2 ^ deg› ‹length treeList = 2 ^ n› deg_not_0 exp_split_high_low(1) in_set_member inthall)
hence abd:"z = ma ⟹ vebt_member( treeList ! (high z (deg div 2))) (low z (deg div 2))"
using aa valid_member_both_member_options by blast
hence abe:"vebt_member( treeList ! (high z (deg div 2))) (low z (deg div 2))"
using "20" ‹z ≠ mi› by blast
hence abf:"both_member_options( treeList ! (high z (deg div 2))) (low z (deg div 2))"
using ‹invar_vebt (treeList ! high z (deg div 2)) n› both_member_options_equiv_member by blast
hence abg:"both_member_options summary (high z (deg div 2))"
by (metis (full_types) "4.hyps"(5) "4.hyps"(6) "4.hyps"(7) ‹deg div 2 = n› ‹invar_vebt (treeList ! the (vebt_succ summary (high x (deg div 2)))) n› ‹z < 2 ^ deg› deg_not_0 exp_split_high_low(1))
hence abh:"vebt_member summary (high z (deg div 2))"
using "4.hyps"(2) valid_member_both_member_options by blast
have aaa:"(high z (deg div 2)) = (high x (deg div 2)) ⟹ vebt_member (treeList ! ?h) (low z (deg div 2))"
using abe by auto
have "high z(deg div 2)< sc ⟹ False"
proof-
assume "high z(deg div 2)< sc"
hence "vebt_member summary (high z(deg div 2))"
using abh by blast
have aaaa:"?h ≤ high z(deg div 2)"
by (simp add: ‹vebt_member (Node (Some (mi, ma)) deg treeList summary) z ∧ x < z› div_le_mono high_def less_imp_le_nat)
have bbbb:"?h ≥ high z(deg div 2)"
using ‹is_succ_in_set (set_vebt' summary) (high x (deg div 2)) sc› ‹high z (deg div 2) < sc› abh leD succ_member by auto
hence "?h = high z (deg div 2)"
using aaaa eq_iff by blast
hence "vebt_member (treeList ! ?h) (low z (deg div 2))"
using aaa by linarith
then show False
by (metis "33" ‹high x (deg div 2) = high z (deg div 2)› ‹vebt_member (Node (Some (mi, ma)) deg treeList summary) z ∧ x < z› add_diff_cancel_left' bit_concat_def bit_split_inv diff_diff_left zero_less_diff)
qed
hence "high z(deg div 2) ≥ sc"
using not_less by blast
then show " z ≥ res"
proof(cases "high z(deg div 2) = sc")
case True
hence "vebt_member (treeList ! (high z(deg div 2))) (low z (deg div 2))"
using abe by blast
have "low z (deg div 2) ≥ miny"
using True ‹min_in_set (set_vebt' (treeList ! the (vebt_succ summary (high x (deg div 2))))) miny› ‹vebt_succ summary (high x (deg div 2)) = Some sc› abe min_in_set_def set_vebt'_def by auto
hence "z ≥ res"
by (metis (full_types) True ‹res = 2 ^ (deg div 2) * sc + miny› add_le_cancel_left bit_concat_def bit_split_inv mult.commute)
then show ?thesis by simp
next
case False
hence "high z(deg div 2) > sc"
using ‹sc ≤ high z (deg div 2)› le_less by blast
then show ?thesis
by (metis ‹high res (deg div 2) = sc› div_le_mono high_def leD linear)
qed
qed
hence "is_succ_in_set (set_vebt' (Node (Some (mi, ma)) deg treeList summary)) x res"
using ‹vebt_member (Node (Some (mi, ma)) deg treeList summary) (the (Some (2 ^ (deg div 2)) *⇩o vebt_succ summary ?h +⇩o vebt_mint (treeList ! the (vebt_succ summary ?h))))›
‹res = the (Some (2 ^ (deg div 2)) *⇩o vebt_succ summary ?h +⇩o vebt_mint (treeList ! the (vebt_succ summary ?h)))› ‹x < res› succ_member by blast
moreover have "Some res = Some (2^(deg div 2)) *⇩o ?sc +⇩o vebt_mint (treeList ! the ?sc)"
by (metis ‹Some miny = vebt_mint (treeList !the (vebt_succ summary (high x (deg div 2))))› ‹res = 2 ^ (deg div 2) * sc + miny› ‹vebt_succ summary (high x (deg div 2)) = Some sc› add_def mul_def option_shift.simps(3))
ultimately show ?thesis
by (metis (mono_tags) is_succ_in_set_def ‹vebt_succ (Node (Some (mi, ma)) deg treeList summary) x = Some (2 ^ (deg div 2)) *⇩o vebt_succ summary ?h +⇩o vebt_mint (treeList ! the (vebt_succ summary ?h))› eq_iff option.inject)
qed
qed
next
case False
hence 0:"vebt_succ (Node (Some (mi, ma)) deg treeList summary) x = None"
by (simp add: ‹2 ≤ deg› ‹mi ≤ x› succ_greatereq_min)
have 1:"x ≥ 2^deg"
by (metis "4.hyps"(4) "4.hyps"(5) "4.hyps"(6) False ‹deg div 2 = n› high_def le_less_linear less_mult_imp_div_less mult_2 power2_eq_square power_even_eq)
hence "x ∉ set_vebt' (Node (Some (mi, ma)) deg treeList summary)"
using "4.hyps"(10) "4.hyps"(9) member_inv set_vebt'_def by fastforce
hence "∄ ss. is_succ_in_set (set_vebt' (Node (Some (mi, ma)) deg treeList summary)) x ss"
using "4.hyps"(10) 1 ‹mi ≤ x› member_inv succ_member by fastforce
then show ?thesis using 0 by auto
qed
qed
next
case (5 treeList n summary m deg mi ma)
hence "Suc n = m" and "deg = n + m" and "length treeList = 2^m ∧ invar_vebt summary m"
by blast +
hence "n ≥ 1"
using "5.hyps"(1) set_n_deg_not_0 by blast
hence "deg ≥ 2"
by (simp add: "5.hyps"(5) "5.hyps"(6))
hence "deg div 2 =n"
by (simp add: "5.hyps"(5) "5.hyps"(6))
then show ?case proof(cases "x < mi")
case True
hence 0: "vebt_succ (Node (Some (mi, ma)) deg treeList summary) x = Some mi"
by (simp add: ‹2 ≤ deg› succ_min)
have 1:"mi = the (vebt_mint (Node (Some (mi, ma)) deg treeList summary))" by simp
hence "mi ∈ set_vebt' (Node (Some (mi, ma)) deg treeList summary)"
by (metis VEBT_Member.vebt_member.simps(5) ‹2 ≤ deg› add_numeral_left arith_simps(1) le_add_diff_inverse mem_Collect_eq numerals(1) plus_1_eq_Suc set_vebt'_def)
hence 2:"y ∈ set_vebt' (Node (Some (mi, ma)) deg treeList summary) ⟹ y ≥ x" for y
using "5.hyps"(9) True member_inv set_vebt'_def by fastforce
hence 3: "y ∈ set_vebt' (Node (Some (mi, ma)) deg treeList summary) ⟹ (y > mi ⟹ y ≥ x)" for y by blast
hence 4: "∀ y ∈ set_vebt' (Node (Some (mi, ma)) deg treeList summary). y > mi ⟶ y ≥ x" by blast
hence "is_succ_in_set (set_vebt' (Node (Some (mi, ma)) deg treeList summary)) x mi"
by (metis (mono_tags, lifting) "5.hyps"(9) True ‹mi ∈ set_vebt' (Node (Some (mi, ma)) deg treeList summary)› eq_iff less_imp_le_nat mem_Collect_eq member_inv succ_member set_vebt'_def)
then show ?thesis using 0
by (metis is_succ_in_set_def antisym_conv option.inject)
next
case False
hence "x ≥ mi"by simp
then show ?thesis
proof(cases "high x (deg div 2)< length treeList ")
case True
hence "high x n < 2^m ∧ low x n < 2^n"
by (simp add: "5.hyps"(4) ‹deg div 2 = n› low_def)
let ?l = "low x (deg div 2)"
let ?h = "high x (deg div 2)"
let ?maxlow = "vebt_maxt (treeList ! ?h)"
let ?sc = "vebt_succ summary ?h"
have 1:"vebt_succ (Node (Some (mi, ma)) deg treeList summary) x =
(if ?maxlow ≠ None ∧ (Some ?l <⇩o ?maxlow) then
Some (2^(deg div 2)) *⇩o Some ?h +⇩o vebt_succ (treeList ! ?h) ?l
else if ?sc = None then None
else Some (2^(deg div 2)) *⇩o ?sc +⇩o vebt_mint (treeList ! the ?sc))"
by (smt True ‹2 ≤ deg› ‹mi ≤ x› succ_less_length_list)
then show ?thesis
proof(cases "?maxlow ≠ None ∧ (Some ?l <⇩o ?maxlow)")
case True
then obtain maxl where 00:"Some maxl = ?maxlow ∧ ?l < maxl" by auto
have 01:"invar_vebt ((treeList ! ?h)) n ∧ (treeList ! ?h) ∈ set treeList "
by (metis (full_types) "5.hyps"(1) "5.hyps"(4) ‹deg div 2 = n› ‹high x n < 2 ^ m ∧ low x n < 2 ^ n› inthall member_def)
have 02:"vebt_member ((treeList ! ?h)) maxl"
using "00" "01" maxt_member by auto
hence 03: "∃ y. y > ?l ∧ vebt_member ((treeList ! ?h)) y"
using "00" by blast
hence afinite: "finite (set_vebt' (treeList ! ?h)) "
using "01" set_vebt_finite by blast
then obtain succy where 04:"is_succ_in_set (set_vebt' (treeList ! ?h)) ?l succy"
using "00" "01" maxt_corr obtain_set_succ by fastforce
hence 05:"Some succy = vebt_succ (treeList ! ?h) ?l" using 5(1) 01 by force
hence "vebt_succ (Node (Some (mi, ma)) deg treeList summary) x = Some (2^(deg div 2)* ?h + succy) "
by (metis "1" True add_def mul_def option_shift.simps(3))
hence 06: "succy ∈ set_vebt' (treeList ! ?h)"
using "04" is_succ_in_set_def by blast
hence 07: "succy < 2^(deg div 2) ∧ ?h < 2^m ∧ Suc (deg div 2 + deg div 2 ) = deg"
using "01" "04" "5.hyps"(5) "5.hyps"(6) ‹high x n < 2 ^ m ∧ low x n < 2 ^ n› member_bound succ_member by auto
let ?y = "2^(deg div 2)* ?h + succy"
have 08: "vebt_member (treeList ! ?h) succy"
using "06" set_vebt'_def by auto
hence 09: "both_member_options (treeList ! ?h) succy"
using "01" both_member_options_equiv_member by blast
have 10: "high ?y (deg div 2) = ?h ∧ low ?y (deg div 2) = succy"
by (simp add: "07" high_inv low_inv mult.commute)
hence 11: "naive_member (treeList ! ?h) succy
⟹ naive_member (Node (Some (mi, ma)) deg treeList summary) ?y"
using naive_member.simps(3)[of "Some (mi, ma)" "deg-1" treeList summary ?y]
using "07" "5.hyps"(4) by auto
have 12: "?y ≥ mi ∧ ?y ≤ ma"
by (metis "01" "07" "09" "10" "5.hyps"(11) "5.hyps"(5) "5.hyps"(8) ‹deg div 2 = n› less_imp_le_nat)
hence 13: "membermima (treeList ! ?h) succy
⟹ membermima (Node (Some (mi, ma)) deg treeList summary) ?y"
using membermima.simps(4)[of mi ma "deg -1" treeList summary ?y]
apply(cases "?y = mi ∨ ?y = ma")
using "07" apply auto[1]
using "07" "10" "5.hyps"(4) by auto
hence 14:"both_member_options (Node (Some (mi, ma)) deg treeList summary) ?y"
using "09" "11" both_member_options_def by blast
have 15: "vebt_member (Node (Some (mi, ma)) deg treeList summary) ?y"
by (smt "07" "08" "10" "12" "5.hyps"(4) "5.hyps"(5) VEBT_Member.vebt_member.simps(5) One_nat_def Suc_1 Suc_le_eq Suc_pred ‹2 ≤ deg› ‹deg div 2 = n› add_gr_0 div_greater_zero_iff not_less zero_less_numeral)
have 16: "Some ?y = vebt_succ (Node (Some (mi, ma)) deg treeList summary) x"
by (simp add: ‹vebt_succ (Node (Some (mi, ma)) deg treeList summary) x = Some (2 ^ (deg div 2) * high x (deg div 2) + succy)›)
have 17: "x = ?h * 2^(deg div 2) + ?l"
using bit_concat_def bit_split_inv by auto
have 18: "?y - x = ?h * 2^(deg div 2) + succy - ?h * 2^(deg div 2) - ?l "
by (metis "17" diff_diff_add mult.commute)
hence "?y -x > 0"
using "04" is_succ_in_set_def by auto
hence 19: "?y > x"
using zero_less_diff by blast
have 20: "z > x ⟹ vebt_member (Node (Some (mi, ma)) deg treeList summary) z ⟹ z≥ ?y " for z
proof-
assume "z > x" and "vebt_member (Node (Some (mi, ma)) deg treeList summary) z"
hence "high z (deg div 2) ≥ high x (deg div 2)"
by (simp add: div_le_mono high_def)
then show ?thesis
proof(cases "high z (deg div 2) = high x (deg div 2)")
case True
hence "vebt_member (treeList ! ?h) (low z (deg div 2))"
using vebt_member.simps(5)[of mi ma "deg-2" treeList summary z]
by (metis "01" "07" "5.hyps"(11) "5.hyps"(5) False ‹deg div 2 = n› ‹vebt_member (Node (Some (mi, ma)) deg treeList summary) z› ‹x < z› both_member_options_equiv_member member_inv)
hence "succy ≤ low z (deg div 2)" using 04 unfolding is_succ_in_set_def
by (metis True ‹x < z› add_diff_cancel_left' bit_concat_def bit_split_inv diff_diff_left mem_Collect_eq set_vebt'_def zero_less_diff)
hence "?y ≤ z"
by (smt True bit_concat_def bit_split_inv diff_add_inverse diff_diff_add diff_is_0_eq mult.commute)
then show ?thesis by blast
next
case False
hence "high z (deg div 2) > high ?y (deg div 2)"
using "10" ‹high x (deg div 2) ≤ high z (deg div 2)› by linarith
then show ?thesis
by (metis div_le_mono high_def nat_le_linear not_le)
qed
qed
hence "is_succ_in_set (set_vebt' (Node (Some (mi, ma)) deg treeList summary)) x ?y"
by (simp add: "15" "19" succ_member)
then show ?thesis using 16
by (metis eq_iff option.inject succ_member)
next
case False
hence i1:"?maxlow = None ∨ ¬ (Some ?l <⇩o ?maxlow)" by simp
hence 2: "vebt_succ (Node (Some (mi, ma)) deg treeList summary) x = (if ?sc = None then None
else Some (2^(deg div 2)) *⇩o ?sc +⇩o vebt_mint (treeList ! the ?sc))"
using "1" by auto
have " invar_vebt (treeList ! ?h) n"
by (metis "5"(1) True inthall member_def)
hence 33:"∄ u. vebt_member (treeList ! ?h) u ∧ u > ?l"
proof(cases "?maxlow = None")
case True
then show ?thesis using maxt_corr_help_empty[of "treeList ! ?h" n]
by (simp add: ‹invar_vebt (treeList ! high x (deg div 2)) n› set_vebt'_def)
next
case False
obtain maxilow where "?maxlow =Some maxilow"
using False by blast
hence "maxilow ≤ ?l"
using "i1" by auto
then show ?thesis
by (meson ‹vebt_maxt (treeList ! high x (deg div 2)) = Some maxilow› ‹invar_vebt (treeList ! high x (deg div 2)) n› le_imp_less_Suc le_less_trans maxt_corr_help not_less_eq)
qed
then show ?thesis
proof(cases " ?sc = None")
case True
hence "vebt_succ (Node (Some (mi, ma)) deg treeList summary) x = None"
by (simp add: "2")
hence "∄ i. is_succ_in_set (set_vebt' summary) ?h i"
using "5.hyps"(3) True by force
hence "∄ i. i > ?h ∧ vebt_member summary i " using succ_none_empty[of "set_vebt' summary" ?h]
proof -
{ fix nn :: nat
have "∀n. ((is_succ_in_set (Collect (vebt_member summary)) (high x (deg div 2)) esk1_0 ∨ infinite (Collect (vebt_member summary))) ∨ n ∉ Collect (vebt_member summary)) ∨ ¬ high x (deg div 2) < n"
using ‹∄i. is_succ_in_set (set_vebt' summary) (high x (deg div 2)) i› succ_none_empty set_vebt'_def by auto
then have "¬ high x (deg div 2) < nn ∨ ¬ vebt_member summary nn"
using "5.hyps"(2) ‹∄i. is_succ_in_set (set_vebt' summary) (high x (deg div 2)) i› set_vebt'_def set_vebt_finite by auto }
then show ?thesis
by blast
qed
hence "(i > x ∧ vebt_member (Node (Some (mi, ma)) deg treeList summary) i) ⟹ False" for i
proof-
fix i
assume "i > x ∧ vebt_member (Node (Some (mi, ma)) deg treeList summary) i"
hence 20: "i = mi ∨ i = ma ∨ (high i (deg div 2) < length treeList
∧ vebt_member ( treeList ! (high i (deg div 2))) (low i (deg div 2)))" using
vebt_member.simps(5)[of mi ma "deg-2" treeList summary i]
using member_inv by blast
have "i ≠ mi"
using ‹mi ≤ x› ‹x < i ∧ vebt_member (Node (Some (mi, ma)) deg treeList summary) i› not_le by blast
hence "mi ≠ ma"
using ‹x < i ∧ vebt_member (Node (Some (mi, ma)) deg treeList summary) i› member_inv not_less_iff_gr_or_eq by blast
hence "i < 2^deg"
using "5.hyps"(10) ‹i ≠ mi› ‹x < i ∧ vebt_member (Node (Some (mi, ma)) deg treeList summary) i› member_inv by fastforce
hence aa:"i = ma ⟹ both_member_options( treeList ! (high i (deg div 2))) (low i (deg div 2))"
using "5.hyps"(11) "5.hyps"(2) "5.hyps"(6) ‹deg div 2 = n› ‹i ≠ mi› ‹invar_vebt (treeList ! high x (deg div 2)) n› deg_not_0 exp_split_high_low(1) by auto
hence abc:"invar_vebt (treeList ! (high i (deg div 2))) n"
by (metis "5.hyps"(1) "5.hyps"(4) "5.hyps"(5) "5.hyps"(6) ‹deg div 2 = n› ‹i < 2 ^ deg› ‹invar_vebt (treeList ! high x (deg div 2)) n› deg_not_0 exp_split_high_low(1) in_set_member inthall zero_less_Suc)
hence abd:"i = ma ⟹ vebt_member( treeList ! (high i (deg div 2))) (low i (deg div 2))"
using aa valid_member_both_member_options by blast
hence abe:"vebt_member( treeList ! (high i (deg div 2))) (low i (deg div 2))"
using "20" ‹i ≠ mi› by blast
hence abf:"both_member_options( treeList ! (high i (deg div 2))) (low i (deg div 2))"
using ‹invar_vebt (treeList ! high i (deg div 2)) n› both_member_options_equiv_member by blast
hence abg:"both_member_options summary (high i (deg div 2))"
by (metis (full_types) "5.hyps"(5) "5.hyps"(6) "5.hyps"(7) ‹deg div 2 = n› ‹i < 2 ^ deg› abc deg_not_0 exp_split_high_low(1) zero_less_Suc)
hence abh:"vebt_member summary (high i (deg div 2))"
using "5.hyps"(2) valid_member_both_member_options by blast
have aaa:"(high i (deg div 2)) = (high x (deg div 2)) ⟹ vebt_member (treeList ! ?h) (low i (deg div 2))"
using ‹vebt_member (treeList ! high i (deg div 2)) (low i (deg div 2))› by auto
have abi:"(high i (deg div 2)) = (high x (deg div 2)) ⟹ low i (deg div 2) > ?l"
by (metis ‹x < i ∧ vebt_member (Node (Some (mi, ma)) deg treeList summary) i› add_le_cancel_left bit_concat_def bit_split_inv le_neq_implies_less less_imp_le_nat nat_neq_iff)
hence abj:"(high i (deg div 2)) = (high x (deg div 2)) ⟹ False" using 33 aaa by blast
hence abk:" (high i (deg div 2)) ∈ (set_vebt' summary) ∧ (high i (deg div 2)) > (high x (deg div 2)) "
by (metis (full_types) ‹vebt_member summary (high i (deg div 2))› ‹x < i ∧ vebt_member (Node (Some (mi, ma)) deg treeList summary) i› div_le_mono high_def le_less mem_Collect_eq set_vebt'_def)
then show ?thesis
using ‹¬ (∃i>high x (deg div 2). vebt_member summary i)› abh by blast
qed
then show ?thesis
using ‹vebt_succ (Node (Some (mi, ma)) deg treeList summary) x = None› succ_member by auto
next
case False
hence "vebt_succ (Node (Some (mi, ma)) deg treeList summary) x =
Some (2^(deg div 2)) *⇩o ?sc +⇩o vebt_mint (treeList ! the ?sc)"
by (simp add: False "2")
obtain sc where "?sc = Some sc"
using False by blast
hence "is_succ_in_set (set_vebt' summary) ?h sc"
using "5.hyps"(3) by blast
hence "vebt_member summary sc"
using succ_member by blast
hence "both_member_options summary sc"
using "5.hyps"(2) both_member_options_equiv_member by auto
hence "sc < 2^m"
using "5.hyps"(2) ‹vebt_member summary sc› member_bound by blast
hence "∃ miny. both_member_options (treeList ! sc) miny"
using "5.hyps"(7) ‹both_member_options summary sc› by blast
hence fgh:"set_vebt' (treeList ! sc) ≠ {}"
by (metis "5.hyps"(1) "5.hyps"(4) ‹sc < 2 ^ m› empty_Collect_eq inthall member_def set_vebt'_def valid_member_both_member_options)
hence "invar_vebt (treeList ! the ?sc) n"
by (simp add: "5.hyps"(1) "5.hyps"(4) ‹sc < 2 ^ m› ‹vebt_succ summary (high x (deg div 2)) = Some sc›)
then obtain miny where "Some miny = vebt_mint (treeList ! sc)"
by (metis fgh Collect_empty_eq VEBT_Member.vebt_member.simps(2) vebt_buildup.simps(2) buildup_gives_empty vebt_mint.elims set_vebt'_def)
hence "Some miny = vebt_mint (treeList ! the ?sc)"
by (simp add: ‹vebt_succ summary (high x (deg div 2)) = Some sc›)
hence "min_in_set (set_vebt' (treeList ! the ?sc)) miny"
using ‹invar_vebt (treeList ! the (vebt_succ summary (high x (deg div 2)))) n› mint_corr by auto
hence scmem:"vebt_member (treeList ! the ?sc) miny"
using ‹Some miny = vebt_mint (treeList ! the (vebt_succ summary (high x (deg div 2))))›
‹invar_vebt (treeList ! the (vebt_succ summary (high x (deg div 2)))) n› mint_member by auto
let ?res = "Some (2^(deg div 2)) *⇩o ?sc +⇩o vebt_mint (treeList ! the ?sc)"
obtain res where "res = the ?res" by blast
hence "res = 2^(deg div 2) * sc + miny"
by (metis ‹Some miny = vebt_mint (treeList ! sc)› ‹vebt_succ summary (high x (deg div 2)) = Some sc› add_shift mul_shift option.sel)
have "high res (deg div 2) = sc"
by (metis ‹deg div 2 = n› ‹res = 2 ^ (deg div 2) * sc + miny› ‹invar_vebt (treeList ! the ?sc) n› high_inv member_bound mult.commute scmem)
hence "res > x"
by (metis is_succ_in_set_def ‹is_succ_in_set (set_vebt' summary) (high x (deg div 2)) sc› div_le_mono high_def not_le)
hence "res > mi"
using ‹mi ≤ x› le_less_trans by blast
hence "res ≤ ma"
proof(cases "high res n < high ma n")
case True
then show ?thesis
by (metis div_le_mono high_def leD nat_le_linear)
next
case False
hence "mi ≠ ma"
by (metis "5.hyps"(4) "5.hyps"(8) ‹∃miny. both_member_options (treeList ! sc) miny› ‹sc < 2 ^ m› nth_mem)
have "high res n < 2^m"
using ‹deg div 2 = n› ‹high res (deg div 2) = sc› ‹sc < 2 ^ m› by blast
hence " (∀x. high x n = high res n ∧ both_member_options (treeList ! (high res n)) (low x n) ⟶ mi < x ∧ x ≤ ma)" using 5(11)
using ‹mi ≠ ma› by blast
have "high res n = high res n ∧ both_member_options (treeList ! (high res n)) (low res n)"
by (metis ‹deg div 2 = n› ‹high res (deg div 2) = sc› ‹res = 2 ^ (deg div 2) * sc + miny› ‹vebt_succ summary (high x (deg div 2)) = Some sc› ‹invar_vebt (treeList ! the (vebt_succ summary (high x (deg div 2)))) n› both_member_options_equiv_member low_inv member_bound mult.commute option.sel scmem)
then show ?thesis
using ‹∀x. high x n = high res n ∧ both_member_options (treeList ! high res n) (low x n) ⟶ mi < x ∧ x ≤ ma› by blast
qed
hence "vebt_member (Node (Some (mi, ma)) deg treeList summary) (the ?res)" using vebt_member.simps(5)[of mi ma "deg-2" treeList summary res]
by (metis "5.hyps"(4) ‹2 ≤ deg› ‹deg div 2 = n› ‹high res (deg div 2) = sc› ‹mi < res› ‹res = 2 ^ (deg div 2) * sc + miny› ‹res = the (Some (2 ^ (deg div 2)) *⇩o vebt_succ summary (high x (deg div 2)) +⇩o vebt_mint (treeList ! the (vebt_succ summary (high x (deg div 2)))))› ‹sc < 2 ^ m› ‹vebt_succ summary (high x (deg div 2)) = Some sc› ‹invar_vebt (treeList ! the (vebt_succ summary (high x (deg div 2)))) n› add_2_eq_Suc' le_add_diff_inverse2 less_imp_le low_inv member_bound mult.commute not_less option.sel scmem)
have "(vebt_member (Node (Some (mi, ma)) deg treeList summary) z ∧ z > x) ⟹ z ≥ res" for z
proof-
fix z
assume "vebt_member (Node (Some (mi, ma)) deg treeList summary) z ∧ z > x"
hence 20: "z = mi ∨ z = ma ∨ (high z (deg div 2) < length treeList
∧ vebt_member ( treeList ! (high z (deg div 2))) (low z (deg div 2)))" using
vebt_member.simps(5)[of mi ma "deg-2" treeList summary z]
using member_inv by blast
have "z ≠ mi"
using ‹vebt_member (Node (Some (mi, ma)) deg treeList summary) z ∧ x < z› ‹mi ≤ x› not_le by blast
hence "mi ≠ ma"
using ‹mi < res› ‹res ≤ ma› not_le by blast
hence "z < 2^deg"
using "5.hyps"(10) ‹vebt_member (Node (Some (mi, ma)) deg treeList summary) z ∧ x < z› ‹z ≠ mi› member_inv by fastforce
hence aa:"z = ma ⟹ both_member_options( treeList ! (high z (deg div 2))) (low z (deg div 2))"
using "5.hyps"(11) "5.hyps"(2) "5.hyps"(6) ‹deg div 2 = n› ‹mi ≠ ma› ‹invar_vebt (treeList ! high x (deg div 2)) n› deg_not_0 exp_split_high_low(1) by auto
hence abc:"invar_vebt (treeList ! (high z (deg div 2))) n"
by (metis "20" "5.hyps"(1) "5.hyps"(10) "5.hyps"(4) "5.hyps"(5) "5.hyps"(6) ‹deg div 2 = n› ‹invar_vebt (treeList ! the(vebt_succ summary (high x (deg div 2)))) n› ‹z ≠ mi› deg_not_0 exp_split_high_low(1) nth_mem zero_less_Suc)
hence abd:"z = ma ⟹ vebt_member( treeList ! (high z (deg div 2))) (low z (deg div 2))"
using aa valid_member_both_member_options by blast
hence abe:"vebt_member( treeList ! (high z (deg div 2))) (low z (deg div 2))"
using "20" ‹z ≠ mi› by blast
hence abf:"both_member_options( treeList ! (high z (deg div 2))) (low z (deg div 2))"
using ‹invar_vebt (treeList ! high z (deg div 2)) n› both_member_options_equiv_member by blast
hence abg:"both_member_options summary (high z (deg div 2))"
by (metis (full_types) "5.hyps"(5) "5.hyps"(6) "5.hyps"(7) ‹deg div 2 = n› ‹invar_vebt (treeList ! the (vebt_succ summary (high x (deg div 2)))) n› ‹z < 2 ^ deg› deg_not_0 exp_split_high_low(1) zero_less_Suc)
hence abh:"vebt_member summary (high z (deg div 2))"
using "5.hyps"(2) valid_member_both_member_options by blast
have aaa:"(high z (deg div 2)) = (high x (deg div 2)) ⟹ vebt_member (treeList ! ?h) (low z (deg div 2))"
using abe by auto
have "high z(deg div 2)< sc ⟹ False"
proof-
assume "high z(deg div 2)< sc"
hence "vebt_member summary (high z(deg div 2))"
using abh by blast
have aaaa:"?h ≤ high z(deg div 2)"
by (simp add: ‹vebt_member (Node (Some (mi, ma)) deg treeList summary) z ∧ x < z› div_le_mono high_def less_imp_le_nat)
have bbbb:"?h ≥ high z(deg div 2)"
using ‹is_succ_in_set (set_vebt' summary) (high x (deg div 2)) sc› ‹high z (deg div 2) < sc› abh leD succ_member by auto
hence "?h = high z (deg div 2)"
using aaaa eq_iff by blast
hence "vebt_member (treeList ! ?h) (low z (deg div 2))"
using aaa by linarith
then show False
by (metis "33" ‹high x (deg div 2) = high z (deg div 2)› ‹vebt_member (Node (Some (mi, ma)) deg treeList summary) z ∧ x < z› add_diff_cancel_left' bit_concat_def bit_split_inv diff_diff_left zero_less_diff)
qed
hence "high z(deg div 2) ≥ sc"
using not_less by blast
then show " z ≥ res"
proof(cases "high z(deg div 2) = sc")
case True
hence "vebt_member (treeList ! (high z(deg div 2))) (low z (deg div 2))"
using abe by blast
have "low z (deg div 2) ≥ miny"
using True ‹min_in_set (set_vebt' (treeList ! the (vebt_succ summary (high x (deg div 2))))) miny› ‹vebt_succ summary (high x (deg div 2)) = Some sc› abe min_in_set_def set_vebt'_def by auto
hence "z ≥ res"
by (metis (full_types) True ‹res = 2 ^ (deg div 2) * sc + miny› add_le_cancel_left bit_concat_def bit_split_inv mult.commute)
then show ?thesis by simp
next
case False
hence "high z(deg div 2) > sc"
using ‹sc ≤ high z (deg div 2)› le_less by blast
then show ?thesis
by (metis ‹high res (deg div 2) = sc› div_le_mono high_def leD linear)
qed
qed
hence "is_succ_in_set (set_vebt' (Node (Some (mi, ma)) deg treeList summary)) x res"
using ‹vebt_member (Node (Some (mi, ma)) deg treeList summary) (the (Some (2 ^ (deg div 2)) *⇩o vebt_succ summary ?h +⇩o vebt_mint (treeList ! the (vebt_succ summary ?h))))›
‹res = the (Some (2 ^ (deg div 2)) *⇩o vebt_succ summary ?h +⇩o vebt_mint (treeList ! the (vebt_succ summary ?h)))› ‹x < res› succ_member by blast
moreover have "Some res = Some (2^(deg div 2)) *⇩o ?sc +⇩o vebt_mint (treeList ! the ?sc)"
by (metis ‹Some miny = vebt_mint (treeList ! the (vebt_succ summary (high x (deg div 2))))› ‹res = 2 ^ (deg div 2) * sc + miny› ‹vebt_succ summary (high x (deg div 2)) = Some sc› add_def mul_def option_shift.simps(3))
ultimately show ?thesis
by (metis (mono_tags) is_succ_in_set_def ‹vebt_succ (Node (Some (mi, ma)) deg treeList summary) x = Some (2 ^ (deg div 2)) *⇩o vebt_succ summary ?h +⇩o vebt_mint (treeList ! the (vebt_succ summary ?h))› eq_iff option.inject)
qed
qed
next
case False
hence 0:"vebt_succ (Node (Some (mi, ma)) deg treeList summary) x = None"
by (simp add: ‹2 ≤ deg› ‹mi ≤ x› succ_greatereq_min)
have 1:"x ≥ 2^deg"
by (metis "5.hyps"(4) "5.hyps"(5) "5.hyps"(6) False One_nat_def Suc_le_eq ‹1 ≤ n› ‹deg div 2 = n› exp_split_high_low(1) leI zero_less_Suc)
hence "x ∉ set_vebt' (Node (Some (mi, ma)) deg treeList summary)"
using "5.hyps"(10) "5.hyps"(9) member_inv set_vebt'_def by fastforce
hence "∄ ss. is_succ_in_set (set_vebt' (Node (Some (mi, ma)) deg treeList summary)) x ss"
using "5.hyps"(10) 1 ‹mi ≤ x› member_inv succ_member by fastforce
then show ?thesis using 0 by auto
qed
qed
qed
corollary succ_empty: assumes "invar_vebt t n "
shows " (vebt_succ t x = None) = ({y. vebt_member t y ∧ y > x} = {})"
proof
show " vebt_succ t x = None ⟹ {y. vebt_member t y ∧ x < y} = {}"
proof
show "vebt_succ t x = None ⟹ {y. vebt_member t y ∧ x < y} ⊆ {}"
proof-
assume "vebt_succ t x = None"
hence "∄ y. is_succ_in_set (set_vebt' t) x y"
using assms succ_corr by force
moreover hence "is_succ_in_set (set_vebt' t) x y ⟹ vebt_member t y ∧ x < y " for y by auto
ultimately show "{y. vebt_member t y ∧ x < y} ⊆ {}"
using assms succ_none_empty set_vebt'_def set_vebt_finite by auto
qed
show " vebt_succ t x = None ⟹ {} ⊆ {y. vebt_member t y ∧ x < y}" by simp
qed
show " {y. vebt_member t y ∧ x < y} = {} ⟹ vebt_succ t x = None"
proof-
assume "{y. vebt_member t y ∧ x < y} = {} "
hence "is_succ_in_set (set_vebt' t) x y ⟹ False" for y
using succ_member by auto
thus "vebt_succ t x = None"
by (meson assms not_Some_eq succ_corr)
qed
qed
theorem succ_correct: "invar_vebt t n ⟹ vebt_succ t x = Some sx ⟷is_succ_in_set (set_vebt t) x sx"
by (simp add: succ_corr set_vebt_set_vebt'_valid)
lemma "is_succ_in_set S x y ⟷ min_in_set {s . s ∈ S ∧ s > x} y"
using is_succ_in_set_def min_in_set_def by fastforce
lemma helpyd:"invar_vebt t n ⟹ vebt_succ t x = Some y ⟹ y < 2^n"
using member_bound succ_corr succ_member by blast
lemma geqmaxNone:
assumes "invar_vebt (Node (Some (mi, ma)) deg treeList summary) n ""x ≥ ma "
shows "vebt_succ (Node (Some (mi, ma)) deg treeList summary) x = None "
proof(rule ccontr)
assume "vebt_succ (Node (Some (mi, ma)) deg treeList summary) x ≠ None"
then obtain y where "vebt_succ (Node (Some (mi, ma)) deg treeList summary) x = Some y" by auto
hence "y > ma ∧ y ∈ set_vebt' ((Node (Some (mi, ma)) deg treeList summary))"
by (smt (verit, ccfv_SIG) assms(1) assms(2) dual_order.strict_trans2 member_inv min_in_set_def vebt_mint.simps(3) mint_corr not_less_iff_gr_or_eq succ_corr succ_member)
then show False
by (metis assms(1) leD vebt_maxt.simps(3) maxt_corr_help mem_Collect_eq set_vebt'_def)
qed
end
end
Theory VEBT_Pred
theory VEBT_Pred imports VEBT_MinMax VEBT_Insert
begin
section ‹The Predecessor Operation›
definition is_pred_in_set :: "nat set ⇒ nat ⇒ nat ⇒ bool" where
"is_pred_in_set xs x y = (y ∈ xs ∧ y < x ∧ (∀ z ∈ xs. (z < x ⟶ z ≤ y)))"
context VEBT_internal begin
subsection ‹Lemmas on Sets and Predecessorship›
corollary pred_member: "is_pred_in_set (set_vebt' t) x y = (vebt_member t y ∧ y < x ∧ (∀ z. vebt_member t z ∧ z < x ⟶ z ≤ y))"
using is_pred_in_set_def set_vebt'_def by auto
lemma "finite (A:: nat set) ⟹ A ≠ {}⟹ Max A ∈ A"
proof(induction A rule: finite.induct)
case emptyI
then show ?case by blast
next
case (insertI A a)
then show ?case
by (meson Max_in finite_insert)
qed
lemma obtain_set_pred: assumes "(x::nat) > z " and "min_in_set A z" and "finite A" shows "∃ y. is_pred_in_set A x y"
proof-
have "{y ∈ A. y < x} ≠ {}"
using assms(1) assms(2) min_in_set_def by auto
hence "Max {y ∈ A. y < x} ∈ {y ∈ A. y < x}"
by (metis (full_types) Max_eq_iff finite_M_bounded_by_nat)
moreover have "i ∈ A⟹ i < x ⟹ i ≤ Max {y ∈ A. y < x} " for i by simp
ultimately have "is_pred_in_set A x (Max {y ∈ A. y < x})"
using is_pred_in_set_def by auto
then show?thesis by auto
qed
lemma pred_none_empty: assumes "(∄ x. is_pred_in_set (xs) a x)" and "finite xs"shows "¬ (∃ x ∈ xs. ord_class.less x a)"
proof-
have "∃ x ∈ xs. ord_class.less x a ⟹ False"
proof-
assume "∃ x ∈ xs. ord_class.less x a"
hence "{x ∈ xs. ord_class.less x a} ≠ {}" by auto
hence "Max {y ∈ xs. y < a} ∈ {y ∈ xs. y < a}"
by (metis (full_types) Max_eq_iff finite_M_bounded_by_nat)
moreover hence "i ∈ xs ⟹ ord_class.less i a⟹
ord_class.less_eq i (Max {y ∈ xs. ord_class.less y a}) " for i
by (simp add: assms(2))
ultimately have "is_pred_in_set xs a (Max {y ∈ xs. y < a})"
using is_pred_in_set_def by auto
then show False
using assms(1) by blast
qed
then show ?thesis by blast
qed
end
subsection ‹The actual Function for Predecessor Search›
context begin
interpretation VEBT_internal .
fun vebt_pred :: "VEBT ⇒ nat ⇒ nat option" where
"vebt_pred (Leaf _ _) 0 = None"|
"vebt_pred (Leaf a _) (Suc 0) = (if a then Some 0 else None)"|
"vebt_pred (Leaf a b) _ = (if b then Some 1 else if a then Some 0 else None)"|
"vebt_pred (Node None _ _ _) _ = None"|
"vebt_pred (Node _ 0 _ _) _ = None"|
"vebt_pred (Node _ (Suc 0) _ _) _ = None"|
"vebt_pred (Node (Some (mi, ma)) deg treeList summary) x = (
if x > ma then Some ma
else (let l = low x (deg div 2); h = high x (deg div 2) in
if h < length treeList then
let minlow = vebt_mint (treeList ! h) in (
if minlow ≠ None ∧ (Some l >⇩o minlow) then
Some (2^(deg div 2)) *⇩o Some h +⇩o vebt_pred (treeList ! h) l
else let pr = vebt_pred summary h in
if pr = None then (
if x > mi then Some mi
else None)
else Some (2^(deg div 2)) *⇩o pr +⇩o vebt_maxt (treeList ! the pr) )
else None))"
end
context VEBT_internal begin
subsection ‹Auxiliary Lemmas›
lemma pred_max:
assumes "deg ≥ 2" and "(x::nat) > ma"
shows "vebt_pred (Node (Some (mi, ma)) deg treeList summary) x = Some ma"
by (metis VEBT_Pred.vebt_pred.simps(7) add_2_eq_Suc assms(1) assms(2) le_add_diff_inverse)
lemma pred_lesseq_max:
assumes "deg ≥ 2" and "(x::nat) ≤ ma"
shows "vebt_pred (Node (Some (mi, ma)) deg treeList summary) x = (let l = low x (deg div 2); h = high x (deg div 2) in
if h < length treeList then
let minlow = vebt_mint (treeList ! h) in
(if minlow ≠ None ∧ (Some l >⇩o minlow) then
Some (2^(deg div 2)) *⇩o Some h +⇩o vebt_pred (treeList ! h) l
else let pr = vebt_pred summary h in
if pr = None then (if x > mi then Some mi else None)
else Some (2^(deg div 2)) *⇩o pr +⇩o vebt_maxt (treeList ! the pr) )
else None)"
by (smt VEBT_Pred.vebt_pred.simps(7) add_numeral_left assms(1) assms(2) leD le_add_diff_inverse numerals(1) plus_1_eq_Suc semiring_norm(2))
lemma pred_list_to_short:
assumes "deg ≥ 2" and "ord_class.less_eq x ma" and " high x (deg div 2) ≥ length treeList"
shows "vebt_pred (Node (Some (mi, ma)) deg treeList summary) x = None"
by (simp add: assms(1) assms(2) assms(3) leD pred_lesseq_max)
lemma pred_less_length_list:
assumes "deg ≥ 2" and "ord_class.less_eq x ma" and " high x (deg div 2) < length treeList"
shows
"vebt_pred (Node (Some (mi, ma)) deg treeList summary) x = (let l = low x (deg div 2); h = high x (deg div 2); minlow = vebt_mint (treeList ! h) in
(if minlow ≠ None ∧ (Some l >⇩o minlow) then
Some (2^(deg div 2)) *⇩o Some h +⇩o vebt_pred (treeList ! h) l
else let pr = vebt_pred summary h in
if pr = None then (if x > mi then Some mi else None)
else Some (2^(deg div 2)) *⇩o pr +⇩o vebt_maxt (treeList ! the pr) ))"
by (simp add: assms(1) assms(2) assms(3) pred_lesseq_max)
subsection ‹Correctness Proof›
theorem pred_corr: "invar_vebt t n ⟹ vebt_pred t x = Some px == is_pred_in_set (set_vebt' t) x px"
proof(induction t n arbitrary: x px rule: invar_vebt.induct)
case (1 a b)
then show ?case
proof(cases x)
case 0
then show ?thesis
by (simp add: is_pred_in_set_def)
next
case (Suc sucX)
hence "x ≥ 0 ∧ x = Suc sucX" by auto
then show ?thesis
proof(cases sucX)
case 0
then show ?thesis
by (simp add: Suc pred_member)
next
case (Suc nat)
hence "x≥ 2"
by (simp add: ‹0 ≤ x ∧ x = Suc sucX›)
then show ?thesis
proof(cases b)
case True
hence "vebt_pred (Leaf a b) x = Some 1"
by (simp add: Suc ‹0 ≤ x ∧ x = Suc sucX›)
moreover have "is_pred_in_set (set_vebt' (Leaf a b)) x 1"
by (simp add: Suc True ‹0 ≤ x ∧ x = Suc sucX› pred_member)
ultimately show ?thesis
using pred_member by auto
next
case False
hence "b = False" by simp
then show ?thesis
proof(cases a)
case True
hence "vebt_pred (Leaf a b) x = Some 0"
by (simp add: False Suc ‹0 ≤ x ∧ x = Suc sucX›)
moreover have "is_pred_in_set (set_vebt' (Leaf a b)) x 0"
by (simp add: False True ‹0 ≤ x ∧ x = Suc sucX› pred_member)
ultimately show ?thesis
by (metis False VEBT_Member.vebt_member.simps(1) option.sel pred_member)
next
case False
then show ?thesis
by (simp add: Suc ‹0 ≤ x ∧ x = Suc sucX› pred_member)
qed
qed
qed
qed
next
case (2 treeList n summary m deg)
then show ?case
by (simp add: pred_member)
next
case (3 treeList n summary m deg)
then show ?case
by (simp add: pred_member)
next
case (4 treeList n summary m deg mi ma)
hence "n = m" and "n ≥ 1" and "deg ≥ 2" and "deg = n + m"
apply blast+
using "4.hyps"(2) "4.hyps"(5) Suc_le_eq deg_not_0 apply auto[1]
using "4.hyps"(2) "4.hyps"(5) "4.hyps"(6) deg_not_0 apply fastforce
by (simp add: "4.hyps"(6))
moreover hence thisvalid:"invar_vebt (Node (Some (mi, ma)) deg treeList summary) deg"
using 4 invar_vebt.intros(4)[of treeList n summary m] by blast
ultimately have "deg div 2 =n" and "length treeList = 2^n"
using add_self_div_2 apply blast by (simp add: "4.hyps"(4) "4.hyps"(5))
then show ?case
proof(cases "x > ma")
case True
hence 0: "vebt_pred (Node (Some (mi, ma)) deg treeList summary) x = Some ma"
by (simp add: ‹2 ≤ deg› pred_max)
have 1:"ma = the (vebt_maxt (Node (Some (mi, ma)) deg treeList summary))" by simp
hence "ma ∈ set_vebt' (Node (Some (mi, ma)) deg treeList summary)"
by (metis VEBT_Member.vebt_member.simps(5) ‹2 ≤ deg› add_numeral_left arith_simps(1) le_add_diff_inverse mem_Collect_eq numerals(1) plus_1_eq_Suc set_vebt'_def)
hence 2:"y ∈ set_vebt' (Node (Some (mi, ma)) deg treeList summary) ⟹ y ≤ x" for y
using "4.hyps"(9) True member_inv set_vebt'_def by fastforce
hence 3: "y ∈ set_vebt' (Node (Some (mi, ma)) deg treeList summary) ⟹ (y < ma ⟹ y ≤ x)" for y by blast
hence 4: "∀ y ∈ set_vebt' (Node (Some (mi, ma)) deg treeList summary). y < ma ⟶ y ≤ x" by blast
hence "is_pred_in_set (set_vebt' (Node (Some (mi, ma)) deg treeList summary)) x ma"
by (metis "4.hyps"(9) True ‹ma ∈ set_vebt' (Node (Some (mi, ma)) deg treeList summary)› less_or_eq_imp_le mem_Collect_eq member_inv pred_member set_vebt'_def)
then show ?thesis
by (metis "0" option.sel leD le_less_Suc_eq not_less_eq pred_member)
next
case False
hence "x ≤ ma"by simp
then show ?thesis
proof(cases "high x (deg div 2)< length treeList ")
case True
hence "high x n < 2^n ∧ low x n < 2^n"
by (simp add: ‹deg div 2 = n› ‹length treeList = 2 ^ n› low_def)
let ?l = "low x (deg div 2)"
let ?h = "high x (deg div 2)"
let ?minlow = "vebt_mint (treeList ! ?h)"
let ?pr = "vebt_pred summary ?h"
have 1:"vebt_pred (Node (Some (mi, ma)) deg treeList summary) x =
(if ?minlow ≠ None ∧ (Some ?l >⇩o ?minlow) then
Some (2^(deg div 2)) *⇩o Some ?h +⇩o vebt_pred (treeList ! ?h) ?l
else let pr = vebt_pred summary ?h in
if pr = None then (if x > mi then Some mi else None)
else Some (2^(deg div 2)) *⇩o pr +⇩o vebt_maxt (treeList ! the pr) )"
by (smt True ‹2 ≤ deg› ‹x ≤ ma› pred_less_length_list)
then show ?thesis
proof(cases "?minlow ≠ None ∧ (Some ?l >⇩o ?minlow)")
case True
then obtain minl where 00:"(Some minl = ?minlow) ∧ ?l > minl" by auto
have 01:"invar_vebt ((treeList ! ?h)) n ∧ (treeList ! ?h) ∈ set treeList "
by (simp add: "4.hyps"(1) "4.hyps"(4) "4.hyps"(5) ‹deg div 2 = n› ‹high x n < 2 ^ n ∧ low x n < 2 ^ n›)
have 02:"vebt_member ((treeList ! ?h)) minl"
using "00" "01" mint_member by auto
hence 03: "∃ y. y < ?l ∧ vebt_member ((treeList ! ?h)) y"
using "00" by blast
hence afinite: "finite (set_vebt' (treeList ! ?h)) "
using "01" set_vebt_finite by blast
then obtain predy where 04:"is_pred_in_set (set_vebt' (treeList ! ?h)) ?l predy"
using "00" "01" mint_corr obtain_set_pred by fastforce
hence 05:"Some predy = vebt_pred (treeList ! ?h) ?l" using 4(1) 01 by force
hence "vebt_pred (Node (Some (mi, ma)) deg treeList summary) x = Some (2^(deg div 2)* ?h + predy) "
using "1" True add_def mul_def option_shift.simps(3) by metis
hence 06: "predy ∈ set_vebt' (treeList ! ?h)"
using "04" is_pred_in_set_def by blast
hence 07: "predy < 2^(deg div 2) ∧ ?h < 2^(deg div 2) ∧ deg div 2 + deg div 2 = deg"
using "01" "04" "4.hyps"(5) "4.hyps"(6) ‹high x n < 2 ^ n ∧ low x n < 2 ^ n› member_bound pred_member by auto
let ?y = "2^(deg div 2)* ?h + predy"
have 08: "vebt_member (treeList ! ?h) predy"
using "06" set_vebt'_def by auto
hence 09: "both_member_options (treeList ! ?h) predy"
using "01" both_member_options_equiv_member by blast
have 10: "high ?y (deg div 2) = ?h ∧ low ?y (deg div 2) = predy"
by (simp add: "07" high_inv low_inv mult.commute)
hence 14:"both_member_options (Node (Some (mi, ma)) deg treeList summary) ?y"
by (metis "07" "09" "4.hyps"(4) "4.hyps"(5) Suc_1 ‹2 ≤ deg› ‹deg div 2 = n› add_leD1 both_member_options_from_chilf_to_complete_tree plus_1_eq_Suc)
have 15: "vebt_member (Node (Some (mi, ma)) deg treeList summary) ?y"
using "14" thisvalid valid_member_both_member_options by blast
have 16: "Some ?y = vebt_pred (Node (Some (mi, ma)) deg treeList summary) x"
by (simp add: ‹vebt_pred (Node (Some (mi, ma)) deg treeList summary) x = Some (2 ^ (deg div 2) * high x (deg div 2) + predy)›)
have 17: "x = ?h * 2^(deg div 2) + ?l"
using bit_concat_def bit_split_inv by auto
have 18: "x - ?y = ?h * 2^(deg div 2) + ?l -?h * 2^(deg div 2) - predy "
by (metis "17" diff_diff_add mult.commute)
hence 19: "?y < x"
using "04" "17" mult.commute nat_add_left_cancel_less pred_member by fastforce
have 20: "z < x ⟹ vebt_member (Node (Some (mi, ma)) deg treeList summary) z ⟹ z≤ ?y " for z
proof-
assume "z < x" and "vebt_member (Node (Some (mi, ma)) deg treeList summary) z"
hence "high z (deg div 2) ≤ high x (deg div 2)"
by (simp add: div_le_mono high_def)
then show ?thesis
proof(cases "high z (deg div 2) = high x (deg div 2)")
case True
hence 0000: "high z (deg div 2) = high x (deg div 2)" by simp
then show ?thesis
proof(cases "z = mi")
case True
then show ?thesis
using "15" vebt_mint.simps(3) mint_corr_help thisvalid by blast
next
case False
hence ad:"vebt_member (treeList ! ?h) (low z (deg div 2))"
using vebt_member.simps(5)[of mi ma "deg-2" treeList summary z]
by (metis True ‹vebt_member (Node (Some (mi, ma)) deg treeList summary) z› ‹x ≤ ma› ‹z < x› leD member_inv)
have "is_pred_in_set (set_vebt' (treeList ! ?h)) ?l predy"
using "04" by blast
have "low z (deg div 2) < ?l"
by (metis (full_types) True ‹z < x› bit_concat_def bit_split_inv nat_add_left_cancel_less)
hence "predy ≥ low z (deg div 2)" using 04 ad unfolding is_pred_in_set_def
by (simp add: set_vebt'_def)
hence "?y ≥ z"
by (smt True bit_concat_def bit_split_inv diff_add_inverse diff_diff_add diff_is_0_eq mult.commute)
then show ?thesis by blast
qed
next
case False
hence "high z (deg div 2) < high ?y (deg div 2)"
using "10" ‹high z (deg div 2) ≤ high x (deg div 2)› by linarith
then show ?thesis
by (metis div_le_mono high_def nat_le_linear not_le)
qed
qed
hence "is_pred_in_set (set_vebt' (Node (Some (mi, ma)) deg treeList summary)) x ?y"
by (simp add: "15" "19" pred_member)
then show ?thesis using 16
by (metis eq_iff option.inject pred_member)
next
case False
hence i1:"?minlow = None ∨ ¬ (Some ?l >⇩o ?minlow)" by simp
hence 2: "vebt_pred (Node (Some (mi, ma)) deg treeList summary) x = (
if ?pr = None then (if x > mi
then Some mi
else None)
else Some (2^(deg div 2)) *⇩o ?pr +⇩o vebt_maxt (treeList ! the ?pr))"
using "1" by auto
have " invar_vebt (treeList ! ?h) n"
by (metis "4"(1) True inthall member_def)
hence 33:"∄ u. vebt_member (treeList ! ?h) u ∧ u < ?l"
proof(cases "?minlow = None")
case True
then show ?thesis using mint_corr_help_empty[of "treeList ! ?h" n]
by (simp add: ‹invar_vebt (treeList ! high x (deg div 2)) n› set_vebt'_def)
next
case False
obtain minilow where "?minlow =Some minilow"
using False by blast
hence "minilow ≥ ?l"
using "i1" by auto
then show ?thesis
by (meson ‹vebt_mint (treeList ! high x (deg div 2)) = Some minilow› ‹invar_vebt (treeList ! high x (deg div 2)) n› leD less_le_trans mint_corr_help)
qed
then show ?thesis
proof(cases "?pr= None")
case True
hence "vebt_pred (Node (Some (mi, ma)) deg treeList summary) x = (if x > mi then Some mi else None)"
by (simp add: "2")
hence "∄ i. is_pred_in_set (set_vebt' summary) ?h i"
using "4.hyps"(3) True by force
hence "∄ i. i < ?h ∧ vebt_member summary i " using pred_none_empty[of "set_vebt' summary" ?h]
proof -
{ fix nn :: nat
have "∀n. ((is_pred_in_set (Collect (vebt_member summary)) (high x (deg div 2)) esk1_0 ∨ infinite (Collect (vebt_member summary))) ∨ n ∉ Collect (vebt_member summary)) ∨ ¬ n < high x (deg div 2)"
using ‹∄i. is_pred_in_set (set_vebt' summary) (high x (deg div 2)) i› pred_none_empty set_vebt'_def by auto
then have "¬ nn < high x (deg div 2) ∨ ¬ vebt_member summary nn"
by (metis (no_types) "4.hyps"(2) ‹∄i. is_pred_in_set (set_vebt' summary) (high x (deg div 2)) i› mem_Collect_eq set_vebt'_def set_vebt_finite) }
then show ?thesis
by blast
qed
then show ?thesis
proof(cases "x > mi")
case True
hence "vebt_pred (Node (Some (mi, ma)) deg treeList summary) x = Some mi"
by (simp add: ‹vebt_pred (Node (Some (mi, ma)) deg treeList summary) x = (if mi < x then Some mi else None)›)
have "(vebt_member (Node (Some (mi, ma)) deg treeList summary) z ∧ z < x ∧ z > mi) ⟹ False" for z
proof-
assume "vebt_member (Node (Some (mi, ma)) deg treeList summary) z ∧ z < x ∧ z > mi"
hence "vebt_member ( treeList ! (high z (deg div 2))) (low z (deg div 2))"
using ‹x ≤ ma› member_inv not_le by blast
moreover hence "high z (deg div 2) < 2^m"
using "4.hyps"(4) ‹vebt_member (Node (Some (mi, ma)) deg treeList summary) z ∧ z < x ∧ mi < z› ‹x ≤ ma› member_inv by fastforce
moreover hence "invar_vebt (treeList ! (high z (deg div 2))) n" using 4(1)
by (simp add: "4.hyps"(4))
ultimately have "vebt_member summary (high z (deg div 2))" using 4(7)
using "4.hyps"(2) both_member_options_equiv_member by blast
have "(high z (deg div 2)) ≤ ?h"
by (simp add: ‹vebt_member (Node (Some (mi, ma)) deg treeList summary) z ∧ z < x ∧ mi < z› div_le_mono high_def less_or_eq_imp_le)
then show False
by (metis "33" ‹¬ (∃i<high x (deg div 2). vebt_member summary i)› ‹vebt_member (Node (Some (mi, ma)) deg treeList summary) z ∧ z < x ∧ mi < z› ‹vebt_member (treeList ! high z (deg div 2)) (low z (deg div 2))› ‹vebt_member summary (high z (deg div 2))› bit_concat_def bit_split_inv le_neq_implies_less nat_add_left_cancel_less)
qed
hence "is_pred_in_set (set_vebt' ((Node (Some (mi, ma)) deg treeList summary))) x mi"
by (metis VEBT_Member.vebt_member.simps(5) True ‹2 ≤ deg› add_2_eq_Suc le_add_diff_inverse le_less_linear pred_member)
then show ?thesis
by (metis ‹vebt_pred (Node (Some (mi, ma)) deg treeList summary) x = Some mi› ‹x ≤ ma› option.sel leD member_inv pred_member)
next
case False
hence "vebt_pred (Node (Some (mi, ma)) deg treeList summary) x = None"
by (simp add: "2" True)
then show ?thesis
by (metis (full_types) False less_trans member_inv option.distinct(1) pred_max pred_member)
qed
next
case False
hence fst:"vebt_pred (Node (Some (mi, ma)) deg treeList summary) x =
Some (2^(deg div 2)) *⇩o ?pr +⇩o vebt_maxt (treeList ! the ?pr)"
using "2" by presburger
obtain pr where "?pr = Some pr"
using False by blast
hence "is_pred_in_set (set_vebt' summary) ?h pr"
using "4.hyps"(3) by blast
hence "vebt_member summary pr"
using pred_member by blast
hence "both_member_options summary pr"
using "4.hyps"(2) both_member_options_equiv_member by auto
hence "pr < 2^m"
using "4.hyps"(2) ‹vebt_member summary pr› member_bound by blast
hence "∃ maxy. both_member_options (treeList ! pr) maxy"
using "4.hyps"(7) ‹both_member_options summary pr› by blast
hence fgh:"set_vebt' (treeList ! pr) ≠ {}"
by (metis "4.hyps"(1) "4.hyps"(2) "4.hyps"(4) ‹vebt_member summary pr› empty_Collect_eq member_bound nth_mem set_vebt'_def valid_member_both_member_options)
hence "invar_vebt (treeList ! the ?pr) n"
by (simp add: "4.hyps"(1) "4.hyps"(4) ‹pr < 2 ^ m› ‹vebt_pred summary (high x (deg div 2)) = Some pr›)
then obtain maxy where "Some maxy = vebt_maxt (treeList ! pr)"
by (metis ‹vebt_pred summary (high x (deg div 2)) = Some pr› fgh option.sel vebt_maxt.elims maxt_corr_help_empty)
hence "Some maxy = vebt_maxt (treeList ! the ?pr)"
by (simp add: ‹vebt_pred summary (high x (deg div 2)) = Some pr›)
hence "max_in_set (set_vebt' (treeList ! the ?pr)) maxy"
using ‹invar_vebt (treeList ! the (vebt_pred summary (high x (deg div 2)))) n› maxt_corr by auto
hence scmem:"vebt_member (treeList ! the ?pr) maxy"
using ‹Some maxy = vebt_maxt (treeList ! the (vebt_pred summary (high x (deg div 2))))› ‹invar_vebt (treeList ! the (vebt_pred summary (high x (deg div 2)))) n› maxt_member by force
let ?res = "Some (2^(deg div 2)) *⇩o ?pr +⇩o vebt_maxt (treeList ! the ?pr)"
obtain res where snd: "res = the ?res" by blast
hence "res = 2^(deg div 2) * pr + maxy"
by (metis ‹Some maxy = vebt_maxt (treeList ! pr)› ‹vebt_pred summary (high x (deg div 2)) = Some pr› add_def option.sel mul_def option_shift.simps(3))
have "high res (deg div 2) = pr"
by (metis ‹deg div 2 = n› ‹res = 2 ^ (deg div 2) * pr + maxy› ‹invar_vebt (treeList ! the ?pr) n› high_inv member_bound mult.commute scmem)
hence "res < x"
by (metis ‹is_pred_in_set (set_vebt' summary) (high x (deg div 2)) pr› div_le_mono high_def pred_member verit_comp_simplify1(3))
have "both_member_options (treeList ! (high res (deg div 2))) (low res (deg div 2))"
by (metis ‹deg div 2 = n› ‹high res (deg div 2) = pr› ‹vebt_pred summary (high x (deg div 2)) = Some pr› ‹res = 2 ^ (deg div 2) * pr + maxy› ‹invar_vebt (treeList ! the (vebt_pred summary (high x (deg div 2)))) n› both_member_options_equiv_member option.sel low_inv member_bound mult.commute scmem)
have "both_member_options (Node (Some (mi, ma)) deg treeList summary) res"
by (metis "4.hyps"(2) "4.hyps"(4) "4.hyps"(6) ‹1 ≤ n› ‹both_member_options (treeList ! high res (deg div 2)) (low res (deg div 2))› ‹high res (deg div 2) = pr› ‹vebt_member summary pr› both_member_options_from_chilf_to_complete_tree member_bound trans_le_add1)
hence "vebt_member (Node (Some (mi, ma)) deg treeList summary) res"
using thisvalid valid_member_both_member_options by auto
hence "res > mi"
by (metis "4.hyps"(11) ‹both_member_options (treeList ! high res (deg div 2)) (low res (deg div 2))› ‹deg div 2 = n› ‹high res (deg div 2) = pr› ‹pr < 2 ^ m› ‹res < x› ‹x ≤ ma› less_le_trans member_inv)
hence "res < ma"
using ‹res < x› ‹x ≤ ma› less_le_trans by blast
have "(vebt_member (Node (Some (mi, ma)) deg treeList summary) z ∧ z < x) ⟹ z ≤ res" for z
proof-
fix z
assume "vebt_member (Node (Some (mi, ma)) deg treeList summary) z ∧ z < x"
hence 20: "z = mi ∨ z = ma ∨ (high z (deg div 2) < length treeList
∧ vebt_member ( treeList ! (high z (deg div 2))) (low z (deg div 2)))" using
vebt_member.simps(5)[of mi ma "deg-2" treeList summary z]
using member_inv by blast
have "z ≠ ma"
using ‹vebt_member (Node (Some (mi, ma)) deg treeList summary) z ∧ z < x› ‹x ≤ ma› leD by blast
hence "mi ≠ ma"
by (metis ‹mi < res› ‹res < x› ‹x ≤ ma› leD less_trans)
hence "z < 2^deg"
using ‹vebt_member (Node (Some (mi, ma)) deg treeList summary) z ∧ z < x› member_bound thisvalid by blast
hence abc:"invar_vebt (treeList ! (high z (deg div 2))) n"
by (metis "4.hyps"(1) "4.hyps"(2) "4.hyps"(5) "4.hyps"(6) ‹deg div 2 = n› ‹z < 2 ^ deg› ‹length treeList = 2 ^ n› deg_not_0 exp_split_high_low(1) in_set_member inthall)
then show "z ≤ res"
proof(cases "z = mi")
case True
then show ?thesis
using ‹mi < res› by auto
next
case False
hence abe:"vebt_member( treeList ! (high z (deg div 2))) (low z (deg div 2))"
using "20" ‹z ≠ ma› by blast
hence abh:"vebt_member summary (high z (deg div 2))"
by (metis "20" "4.hyps"(2) "4.hyps"(4) "4.hyps"(7) False ‹vebt_member (Node (Some (mi, ma)) deg treeList summary) z ∧ z < x› ‹x ≤ ma› abc both_member_options_equiv_member not_le)
have aaa:"(high z (deg div 2)) = (high x (deg div 2)) ⟹ vebt_member (treeList ! ?h) (low z (deg div 2))"
using abe by auto
have "high z(deg div 2) > pr ⟹ False"
proof-
assume "high z(deg div 2) > pr"
hence "vebt_member summary (high z(deg div 2))"
using abh by blast
have aaaa:"?h ≤ high z(deg div 2)"
by (meson ‹is_pred_in_set (set_vebt' summary) (high x (deg div 2)) pr› ‹pr < high z (deg div 2)› abh leD not_le_imp_less pred_member)
have bbbb:"?h ≥ high z(deg div 2)"
by (simp add: ‹vebt_member (Node (Some (mi, ma)) deg treeList summary) z ∧ z < x› div_le_mono dual_order.strict_implies_order high_def)
hence "?h = high z (deg div 2)"
using aaaa eq_iff by blast
hence "vebt_member (treeList ! ?h) (low z (deg div 2))"
using aaa by linarith
hence "(low z (deg div 2)) < ?l"
by (metis ‹high x (deg div 2) = high z (deg div 2)› ‹vebt_member (Node (Some (mi, ma)) deg treeList summary) z ∧ z < x› add_le_cancel_left div_mult_mod_eq high_def less_le low_def)
then show False
using "33" ‹vebt_member (treeList ! high x (deg div 2)) (low z (deg div 2))› by blast
qed
hence "high z(deg div 2) ≤ pr"
using not_less by blast
then show " z ≤ res"
proof(cases "high z(deg div 2) = pr")
case True
hence "vebt_member (treeList ! (high z(deg div 2))) (low z (deg div 2))"
using abe by blast
have "low z (deg div 2) ≤ maxy"
using True ‹Some maxy = vebt_maxt (treeList ! pr)› abc abe maxt_corr_help by auto
hence "z ≤ res"
by (metis True ‹res = 2 ^ (deg div 2) * pr + maxy› add_le_cancel_left div_mult_mod_eq high_def low_def mult.commute)
then show ?thesis by simp
next
case False
hence "high z(deg div 2) < pr"
by (simp add: ‹high z (deg div 2) ≤ pr› less_le)
then show ?thesis
by (metis ‹high res (deg div 2) = pr› div_le_mono high_def leD linear)
qed
qed
qed
hence "is_pred_in_set (set_vebt' (Node (Some (mi, ma)) deg treeList summary)) x res"
using ‹vebt_member (Node (Some (mi, ma)) deg treeList summary) res› ‹res < x› pred_member by presburger
then show ?thesis using fst snd
by (metis ‹Some maxy = vebt_maxt (treeList ! the (vebt_pred summary (high x (deg div 2))))› ‹vebt_pred summary (high x (deg div 2)) = Some pr› ‹res = 2 ^ (deg div 2) * pr + maxy› add_shift dual_order.eq_iff mul_shift pred_member)
qed
qed
next
case False
then show ?thesis
by (metis "4.hyps"(10) "4.hyps"(5) "4.hyps"(6) ‹1 ≤ n› ‹deg div 2 = n› ‹length treeList = 2 ^ n› ‹x ≤ ma› exp_split_high_low(1) le_less_trans le_neq_implies_less not_less not_less_zero zero_neq_one)
qed
qed
next
case (5 treeList n summary m deg mi ma)
hence "Suc n = m" and "deg = n + m" and "length treeList = 2^m ∧ invar_vebt summary m"
by blast +
hence "n ≥ 1"
using "5.hyps"(1) set_n_deg_not_0 by blast
hence "deg ≥ 2"
by (simp add: "5.hyps"(5) "5.hyps"(6))
hence "deg div 2 =n"
by (simp add: "5.hyps"(5) "5.hyps"(6))
moreover hence thisvalid:"invar_vebt (Node (Some (mi, ma)) deg treeList summary) deg"
using 5 invar_vebt.intros(5)[of treeList n summary m] by blast
ultimately have "deg div 2 =n" by simp
then show ?case
proof(cases "x > ma")
case True
hence 0: "vebt_pred (Node (Some (mi, ma)) deg treeList summary) x = Some ma"
by (simp add: ‹2 ≤ deg› pred_max)
have 1:"ma = the (vebt_maxt (Node (Some (mi, ma)) deg treeList summary))" by simp
hence "ma ∈ set_vebt' (Node (Some (mi, ma)) deg treeList summary)"
by (metis VEBT_Member.vebt_member.simps(5) ‹2 ≤ deg› add_numeral_left arith_simps(1) le_add_diff_inverse mem_Collect_eq numerals(1) plus_1_eq_Suc set_vebt'_def)
hence 2:"y ∈ set_vebt' (Node (Some (mi, ma)) deg treeList summary) ⟹ y ≤ x" for y
using "5.hyps"(9) True member_inv set_vebt'_def by fastforce
hence 3: "y ∈ set_vebt' (Node (Some (mi, ma)) deg treeList summary) ⟹ (y < ma ⟹ y ≤ x)" for y by blast
hence 4: "∀ y ∈ set_vebt' (Node (Some (mi, ma)) deg treeList summary). y < ma ⟶ y ≤ x" by blast
hence "is_pred_in_set (set_vebt' (Node (Some (mi, ma)) deg treeList summary)) x ma"
by (metis "5.hyps"(9) True ‹ma ∈ set_vebt' (Node (Some (mi, ma)) deg treeList summary)› less_or_eq_imp_le mem_Collect_eq member_inv pred_member set_vebt'_def)
then show ?thesis
by (metis "0" option.sel leD le_less_Suc_eq not_less_eq pred_member)
next
case False
hence "x ≤ ma"by simp
then show ?thesis
proof(cases "high x (deg div 2)< length treeList ")
case True
hence "high x n < 2^m ∧ low x n < 2^n"
by (simp add: ‹deg div 2 = n› ‹length treeList = 2 ^ m› low_def)
let ?l = "low x (deg div 2)"
let ?h = "high x (deg div 2)"
let ?minlow = "vebt_mint (treeList ! ?h)"
let ?pr = "vebt_pred summary ?h"
have 1:"vebt_pred (Node (Some (mi, ma)) deg treeList summary) x =
(if ?minlow ≠ None ∧ (Some ?l >⇩o ?minlow) then
Some (2^(deg div 2)) *⇩o Some ?h +⇩o vebt_pred (treeList ! ?h) ?l
else let pr = vebt_pred summary ?h in
if pr = None then (if x > mi then Some mi else None)
else Some (2^(deg div 2)) *⇩o pr +⇩o vebt_maxt (treeList ! the pr) )"
by (smt True ‹2 ≤ deg› ‹x ≤ ma› pred_less_length_list)
then show ?thesis
proof(cases "?minlow ≠ None ∧ (Some ?l >⇩o ?minlow)")
case True
then obtain minl where 00:"(Some minl = ?minlow) ∧ ?l > minl" by auto
have 01:"invar_vebt ((treeList ! ?h)) n ∧ (treeList ! ?h) ∈ set treeList "
by (metis "5.hyps"(1) ‹deg div 2 = n› ‹high x n < 2 ^ m ∧ low x n < 2 ^ n› ‹length treeList = 2 ^ m ∧ invar_vebt summary m› inthall member_def)
have 02:"vebt_member ((treeList ! ?h)) minl"
using "00" "01" mint_member by auto
hence 03: "∃ y. y < ?l ∧ vebt_member ((treeList ! ?h)) y"
using "00" by blast
hence afinite: "finite (set_vebt' (treeList ! ?h)) "
using "01" set_vebt_finite by blast
then obtain predy where 04:"is_pred_in_set (set_vebt' (treeList ! ?h)) ?l predy"
using "00" "01" mint_corr obtain_set_pred by fastforce
hence 05:"Some predy = vebt_pred (treeList ! ?h) ?l" using 5(1) 01 by force
hence "vebt_pred (Node (Some (mi, ma)) deg treeList summary) x = Some (2^(deg div 2)* ?h + predy) "
by (metis "1" True add_def mul_def option_shift.simps(3))
hence 06: "predy ∈ set_vebt' (treeList ! ?h)"
using "04" is_pred_in_set_def by blast
hence 07: "predy < 2^(deg div 2) ∧ ?h < 2^(deg div 2 +1) ∧ deg div 2 + deg div 2 +1 = deg"
using "04" "5.hyps"(5) "5.hyps"(6) ‹high x n < 2 ^ m ∧ low x n < 2 ^ n› pred_member by force
let ?y = "2^(deg div 2)* ?h + predy"
have 08: "vebt_member (treeList ! ?h) predy"
using "06" set_vebt'_def by auto
hence 09: "both_member_options (treeList ! ?h) predy"
using "01" both_member_options_equiv_member by blast
have 10: "high ?y (deg div 2) = ?h ∧ low ?y (deg div 2) = predy"
by (simp add: "07" high_inv low_inv mult.commute)
hence 14:"both_member_options (Node (Some (mi, ma)) deg treeList summary) ?y"
using "07" "09" "5.hyps"(4) ‹deg div 2 = n› ‹high x n < 2 ^ m ∧ low x n < 2 ^ n› both_member_options_from_chilf_to_complete_tree by auto
have 15: "vebt_member (Node (Some (mi, ma)) deg treeList summary) ?y"
using "14" thisvalid valid_member_both_member_options by blast
have 16: "Some ?y = vebt_pred (Node (Some (mi, ma)) deg treeList summary) x"
by (simp add: ‹vebt_pred (Node (Some (mi, ma)) deg treeList summary) x = Some (2 ^ (deg div 2) * high x (deg div 2) + predy)›)
have 17: "x = ?h * 2^(deg div 2) + ?l"
using bit_concat_def bit_split_inv by auto
have 18: "x - ?y = ?h * 2^(deg div 2) + ?l -?h * 2^(deg div 2) - predy "
by (metis "17" diff_diff_add mult.commute)
hence 19: "?y < x"
using "04" "17" mult.commute nat_add_left_cancel_less pred_member by fastforce
have 20: "z < x ⟹ vebt_member (Node (Some (mi, ma)) deg treeList summary) z ⟹ z≤ ?y " for z
proof-
assume "z < x" and "vebt_member (Node (Some (mi, ma)) deg treeList summary) z"
hence "high z (deg div 2) ≤ high x (deg div 2)"
by (simp add: div_le_mono high_def)
then show ?thesis
proof(cases "high z (deg div 2) = high x (deg div 2)")
case True
hence 0000: "high z (deg div 2) = high x (deg div 2)" by simp
then show ?thesis
proof(cases "z = mi")
case True
then show ?thesis
by (metis "15" "5.hyps"(9) add.left_neutral le_add2 less_imp_le_nat member_inv)
next
case False
hence ad:"vebt_member (treeList ! ?h) (low z (deg div 2))"
using vebt_member.simps(5)[of mi ma "deg-2" treeList summary z]
by (metis True ‹vebt_member (Node (Some (mi, ma)) deg treeList summary) z› ‹x ≤ ma› ‹z < x› leD member_inv)
have "is_pred_in_set (set_vebt' (treeList ! ?h)) ?l predy"
using "04" by blast
have "low z (deg div 2) < ?l"
by (metis (full_types) True ‹z < x› bit_concat_def bit_split_inv nat_add_left_cancel_less)
hence "predy ≥ low z (deg div 2)" using 04 ad unfolding is_pred_in_set_def
by (simp add: set_vebt'_def)
hence "?y ≥ z"
by (smt True bit_concat_def bit_split_inv diff_add_inverse diff_diff_add diff_is_0_eq mult.commute)
then show ?thesis by blast
qed
next
case False
hence "high z (deg div 2) < high ?y (deg div 2)"
using "10" ‹high z (deg div 2) ≤ high x (deg div 2)› by linarith
then show ?thesis
by (metis div_le_mono high_def nat_le_linear not_le)
qed
qed
hence "is_pred_in_set (set_vebt'(Node (Some (mi, ma)) deg treeList summary)) x ?y"
by (simp add: "15" "19" pred_member)
then show ?thesis using 16
by (metis eq_iff option.inject pred_member)
next
case False
hence i1:"?minlow = None ∨ ¬ (Some ?l >⇩o ?minlow)" by simp
hence 2: "vebt_pred (Node (Some (mi, ma)) deg treeList summary) x = (
if ?pr = None then (if x > mi
then Some mi
else None)
else Some (2^(deg div 2)) *⇩o ?pr +⇩o vebt_maxt (treeList ! the ?pr))"
using "1" by auto
have " invar_vebt (treeList ! ?h) n"
by (metis "5"(1) True inthall member_def)
hence 33:"∄ u. vebt_member (treeList ! ?h) u ∧ u < ?l"
proof(cases "?minlow = None")
case True
then show ?thesis using mint_corr_help_empty[of "treeList ! ?h" n]
by (simp add: ‹invar_vebt (treeList ! high x (deg div 2)) n› set_vebt'_def)
next
case False
obtain minilow where "?minlow =Some minilow"
using False by blast
hence "minilow ≥ ?l"
using "i1" by auto
then show ?thesis
by (meson ‹vebt_mint (treeList ! high x (deg div 2)) = Some minilow› ‹invar_vebt (treeList ! high x (deg div 2)) n› leD less_le_trans mint_corr_help)
qed
then show ?thesis
proof(cases "?pr= None")
case True
hence "vebt_pred (Node (Some (mi, ma)) deg treeList summary) x = (if x > mi then Some mi else None)"
by (simp add: "2")
hence "∄ i. is_pred_in_set (set_vebt' summary) ?h i"
using "5.hyps"(3) True by force
hence "∄ i. i < ?h ∧ vebt_member summary i " using pred_none_empty[of "set_vebt' summary" ?h]
proof -
{ fix nn :: nat
have "∀n. ((is_pred_in_set (Collect (vebt_member summary)) (high x (deg div 2)) esk1_0 ∨ infinite (Collect (vebt_member summary))) ∨ n ∉ Collect (vebt_member summary)) ∨ ¬ n < high x (deg div 2)"
using ‹∄i. is_pred_in_set (set_vebt' summary) (high x (deg div 2)) i› pred_none_empty set_vebt'_def by auto
then have "¬ nn < high x (deg div 2) ∨ ¬ vebt_member summary nn"
by (metis (no_types) "5.hyps"(2) ‹∄i. is_pred_in_set (set_vebt' summary) (high x (deg div 2)) i› mem_Collect_eq set_vebt'_def set_vebt_finite) }
then show ?thesis
by blast
qed
then show ?thesis
proof(cases "x > mi")
case True
hence "vebt_pred (Node (Some (mi, ma)) deg treeList summary) x = Some mi"
by (simp add: ‹vebt_pred (Node (Some (mi, ma)) deg treeList summary) x = (if mi < x then Some mi else None)›)
have "(vebt_member (Node (Some (mi, ma)) deg treeList summary) z ∧ z < x ∧ z > mi) ⟹ False" for z
proof-
assume "vebt_member (Node (Some (mi, ma)) deg treeList summary) z ∧ z < x ∧ z > mi"
hence "vebt_member ( treeList ! (high z (deg div 2))) (low z (deg div 2))"
using ‹x ≤ ma› member_inv not_le by blast
moreover hence "high z (deg div 2) < 2^m"
using "5.hyps"(4) ‹vebt_member (Node (Some (mi, ma)) deg treeList summary) z ∧ z < x ∧ mi < z› ‹x ≤ ma› member_inv by fastforce
moreover hence "invar_vebt (treeList ! (high z (deg div 2))) n" using 5(1)
by (simp add: "5.hyps"(4))
ultimately have "vebt_member summary (high z (deg div 2))" using 5(7)
using "5.hyps"(2) both_member_options_equiv_member by blast
have "(high z (deg div 2)) ≤ ?h"
by (simp add: ‹vebt_member (Node (Some (mi, ma)) deg treeList summary) z ∧ z < x ∧ mi < z› div_le_mono high_def less_or_eq_imp_le)
then show False
by (metis "33" ‹¬ (∃i<high x (deg div 2). vebt_member summary i)› ‹vebt_member (Node (Some (mi, ma)) deg treeList summary) z ∧ z < x ∧ mi < z› ‹vebt_member (treeList ! high z (deg div 2)) (low z (deg div 2))› ‹vebt_member summary (high z (deg div 2))› bit_concat_def bit_split_inv le_neq_implies_less nat_add_left_cancel_less)
qed
hence "is_pred_in_set (set_vebt' ((Node (Some (mi, ma)) deg treeList summary))) x mi"
by (metis VEBT_Member.vebt_member.simps(5) True ‹2 ≤ deg› add_2_eq_Suc le_add_diff_inverse le_less_linear pred_member)
then show ?thesis
by (metis ‹vebt_pred (Node (Some (mi, ma)) deg treeList summary) x = Some mi› ‹x ≤ ma› option.sel leD member_inv pred_member)
next
case False
hence "vebt_pred (Node (Some (mi, ma)) deg treeList summary) x = None"
by (simp add: "2" True)
then show ?thesis
by (metis (full_types) False less_trans member_inv option.distinct(1) pred_max pred_member)
qed
next
case False
hence fst:"vebt_pred (Node (Some (mi, ma)) deg treeList summary) x =
Some (2^(deg div 2)) *⇩o ?pr +⇩o vebt_maxt (treeList ! the ?pr)"
using "2" by presburger
obtain pr where "?pr = Some pr"
using False by blast
hence "is_pred_in_set (set_vebt' summary) ?h pr"
using "5.hyps"(3) by blast
hence "vebt_member summary pr"
using pred_member by blast
hence "both_member_options summary pr"
using "5.hyps"(2) both_member_options_equiv_member by auto
hence "pr < 2^m"
using "5.hyps"(2) ‹vebt_member summary pr› member_bound by blast
hence "∃ maxy. both_member_options (treeList ! pr) maxy"
using "5.hyps"(7) ‹both_member_options summary pr› by blast
hence fgh:"set_vebt' (treeList ! pr) ≠ {}"
by (metis "5.hyps"(1) "5.hyps"(4) Collect_empty_eq ‹pr < 2 ^ m› nth_mem set_vebt'_def valid_member_both_member_options)
hence "invar_vebt (treeList ! the ?pr) n"
by (simp add: "5.hyps"(1) "5.hyps"(4) ‹pr < 2 ^ m› ‹vebt_pred summary (high x (deg div 2)) = Some pr›)
then obtain maxy where "Some maxy = vebt_maxt (treeList ! pr)"
by (metis ‹vebt_pred summary (high x (deg div 2)) = Some pr› fgh option.sel vebt_maxt.elims maxt_corr_help_empty)
hence "Some maxy = vebt_maxt (treeList ! the ?pr)"
by (simp add: ‹vebt_pred summary (high x (deg div 2)) = Some pr›)
hence "max_in_set (set_vebt' (treeList ! the ?pr)) maxy"
using ‹invar_vebt (treeList ! the (vebt_pred summary (high x (deg div 2)))) n› maxt_corr by auto
hence scmem:"vebt_member (treeList ! the ?pr) maxy"
using ‹Some maxy = vebt_maxt (treeList ! the (vebt_pred summary (high x (deg div 2))))› ‹invar_vebt (treeList ! the (vebt_pred summary (high x (deg div 2)))) n› maxt_member by force
let ?res = "Some (2^(deg div 2)) *⇩o ?pr +⇩o vebt_maxt (treeList ! the ?pr)"
obtain res where snd: "res = the ?res" by blast
hence "res = 2^(deg div 2) * pr + maxy"
by (metis ‹Some maxy = vebt_maxt (treeList ! pr)› ‹vebt_pred summary (high x (deg div 2)) = Some pr› add_def option.sel mul_def option_shift.simps(3))
have "high res (deg div 2) = pr"
by (metis ‹deg div 2 = n› ‹res = 2 ^ (deg div 2) * pr + maxy› ‹invar_vebt (treeList ! the ?pr) n› high_inv member_bound mult.commute scmem)
hence "res < x"
by (metis ‹is_pred_in_set (set_vebt' summary) (high x (deg div 2)) pr› div_le_mono high_def pred_member verit_comp_simplify1(3))
have "both_member_options (treeList ! (high res (deg div 2))) (low res (deg div 2))"
by (metis ‹deg div 2 = n› ‹high res (deg div 2) = pr› ‹vebt_pred summary (high x (deg div 2)) = Some pr› ‹res = 2 ^ (deg div 2) * pr + maxy› ‹invar_vebt (treeList ! the (vebt_pred summary (high x (deg div 2)))) n› both_member_options_equiv_member option.sel low_inv member_bound mult.commute scmem)
have "both_member_options (Node (Some (mi, ma)) deg treeList summary) res"
by (metis "5.hyps"(2) "5.hyps"(4) "5.hyps"(6) ‹1 ≤ n› ‹both_member_options (treeList ! high res (deg div 2)) (low res (deg div 2))› ‹high res (deg div 2) = pr› ‹vebt_member summary pr› both_member_options_from_chilf_to_complete_tree member_bound trans_le_add1)
hence "vebt_member (Node (Some (mi, ma)) deg treeList summary) res"
using thisvalid valid_member_both_member_options by auto
hence "res > mi"
by (metis "5.hyps"(11) ‹both_member_options (treeList ! high res (deg div 2)) (low res (deg div 2))› ‹deg div 2 = n› ‹high res (deg div 2) = pr› ‹pr < 2 ^ m› ‹res < x› ‹x ≤ ma› less_le_trans member_inv)
hence "res < ma"
using ‹res < x› ‹x ≤ ma› less_le_trans by blast
have "(vebt_member (Node (Some (mi, ma)) deg treeList summary) z ∧ z < x) ⟹ z ≤ res" for z
proof-
fix z
assume "vebt_member (Node (Some (mi, ma)) deg treeList summary) z ∧ z < x"
hence 20: "z = mi ∨ z = ma ∨ (high z (deg div 2) < length treeList
∧ vebt_member ( treeList ! (high z (deg div 2))) (low z (deg div 2)))" using
vebt_member.simps(5)[of mi ma "deg-2" treeList summary z]
using member_inv by blast
have "z ≠ ma"
using ‹vebt_member (Node (Some (mi, ma)) deg treeList summary) z ∧ z < x› ‹x ≤ ma› leD by blast
hence "mi ≠ ma"
by (metis ‹mi < res› ‹res < x› ‹x ≤ ma› leD less_trans)
hence "z < 2^deg"
using ‹vebt_member (Node (Some (mi, ma)) deg treeList summary) z ∧ z < x› member_bound thisvalid by blast
hence "(high z (deg div 2)) <2^m"
by (metis "5.hyps"(5) "5.hyps"(6) ‹1 ≤ n› ‹deg div 2 = n› exp_split_high_low(1) less_le_trans numeral_One zero_less_Suc zero_less_numeral)
hence abc:"invar_vebt (treeList ! (high z (deg div 2))) n"
by (simp add: "5.hyps"(1) "5.hyps"(4))
then show "z ≤ res"
proof(cases "z = mi")
case True
then show ?thesis
using ‹mi < res› by auto
next
case False
hence abe:"vebt_member( treeList ! (high z (deg div 2))) (low z (deg div 2))"
using "20" ‹z ≠ ma› by blast
hence abh:"vebt_member summary (high z (deg div 2))"
using "5.hyps"(7) ‹high z (deg div 2) < 2 ^ m› ‹length treeList = 2 ^ m ∧ invar_vebt summary m› abc both_member_options_equiv_member by blast
have aaa:"(high z (deg div 2)) = (high x (deg div 2)) ⟹ vebt_member (treeList ! ?h) (low z (deg div 2))"
using abe by auto
have "high z(deg div 2) > pr ⟹ False"
proof-
assume "high z(deg div 2) > pr"
hence "vebt_member summary (high z(deg div 2))"
using abh by blast
have aaaa:"?h ≤ high z(deg div 2)"
by (meson ‹is_pred_in_set (set_vebt' summary) (high x (deg div 2)) pr› ‹pr < high z (deg div 2)› abh leD not_le_imp_less pred_member)
have bbbb:"?h ≥ high z(deg div 2)"
by (simp add: ‹vebt_member (Node (Some (mi, ma)) deg treeList summary) z ∧ z < x› div_le_mono dual_order.strict_implies_order high_def)
hence "?h = high z (deg div 2)"
using aaaa eq_iff by blast
hence "vebt_member (treeList ! ?h) (low z (deg div 2))"
using aaa by linarith
hence "(low z (deg div 2)) < ?l"
by (metis ‹high x (deg div 2) = high z (deg div 2)› ‹vebt_member (Node (Some (mi, ma)) deg treeList summary) z ∧ z < x› add_le_cancel_left div_mult_mod_eq high_def less_le low_def)
then show False
using "33" ‹vebt_member (treeList ! high x (deg div 2)) (low z (deg div 2))› by blast
qed
hence "high z(deg div 2) ≤ pr"
using not_less by blast
then show " z ≤ res"
proof(cases "high z(deg div 2) = pr")
case True
hence "vebt_member (treeList ! (high z(deg div 2))) (low z (deg div 2))"
using abe by blast
have "low z (deg div 2) ≤ maxy"
using True ‹Some maxy = vebt_maxt (treeList ! pr)› abc abe maxt_corr_help by auto
hence "z ≤ res"
by (metis True ‹res = 2 ^ (deg div 2) * pr + maxy› add_le_cancel_left div_mult_mod_eq high_def low_def mult.commute)
then show ?thesis by simp
next
case False
hence "high z(deg div 2) < pr"
by (simp add: ‹high z (deg div 2) ≤ pr› less_le)
then show ?thesis
by (metis ‹high res (deg div 2) = pr› div_le_mono high_def leD linear)
qed
qed
qed
hence "is_pred_in_set (set_vebt' (Node (Some (mi, ma)) deg treeList summary)) x res"
using ‹vebt_member (Node (Some (mi, ma)) deg treeList summary) res› ‹res < x› pred_member by presburger
then show ?thesis using fst snd
by (metis ‹Some maxy = vebt_maxt (treeList ! the (vebt_pred summary (high x (deg div 2))))› ‹vebt_pred summary (high x (deg div 2)) = Some pr› ‹res = 2 ^ (deg div 2) * pr + maxy› add_shift dual_order.eq_iff mul_shift pred_member)
qed
qed
next
case False
then show ?thesis
by (metis "5.hyps"(10) "5.hyps"(4) "5.hyps"(5) "5.hyps"(6) ‹1 ≤ n› ‹deg div 2 = n› ‹x ≤ ma› exp_split_high_low(1) le_0_eq le_less_trans verit_comp_simplify1(3) zero_less_Suc zero_neq_one)
qed
qed
qed
corollary pred_empty: assumes "invar_vebt t n "
shows " (vebt_pred t x = None) = ({y. vebt_member t y ∧ y < x} = {})"
proof
show " vebt_pred t x = None ⟹ {y. vebt_member t y ∧ x > y} = {}"
proof
show "vebt_pred t x = None ⟹ {y. vebt_member t y ∧ x > y} ⊆ {}"
proof-
assume "vebt_pred t x = None"
hence "∄ y. is_pred_in_set (set_vebt' t) x y"
using assms pred_corr by force
moreover hence "is_pred_in_set (set_vebt' t) x y ⟹ vebt_member t y ∧ x < y " for y by auto
ultimately show "{y. vebt_member t y ∧ x > y} ⊆ {}"
using assms pred_none_empty set_vebt'_def set_vebt_finite by auto
qed
show " vebt_pred t x = None ⟹ {} ⊆ {y. vebt_member t y ∧ x > y}" by simp
qed
show " {y. vebt_member t y ∧ x > y} = {} ⟹ vebt_pred t x = None"
proof-
assume "{y. vebt_member t y ∧ x > y} = {} "
hence "is_pred_in_set (set_vebt' t) x y ⟹ False" for y
using pred_member by auto
thus "vebt_pred t x = None"
by (meson assms option_shift.elims pred_corr)
qed
qed
theorem pred_correct: "invar_vebt t n ⟹ vebt_pred t x = Some sx ⟷is_pred_in_set (set_vebt t) x sx"
by (simp add: pred_corr set_vebt_set_vebt'_valid)
lemma helpypredd:"invar_vebt t n ⟹ vebt_pred t x = Some y ⟹ y < 2^n"
using member_bound pred_corr pred_member by blast
lemma "invar_vebt t n ⟹ vebt_pred t x = Some y ⟹ y < x"
by (simp add: pred_corr pred_member)
end
end
Theory VEBT_Delete
theory VEBT_Delete imports VEBT_Pred VEBT_Succ
begin
section ‹Deletion›
subsection ‹Function Definition›
context begin
interpretation VEBT_internal .
fun vebt_delete :: "VEBT ⇒ nat ⇒ VEBT" where
"vebt_delete (Leaf a b) 0 = Leaf False b"|
"vebt_delete (Leaf a b) (Suc 0) = Leaf a False"|
"vebt_delete (Leaf a b) (Suc (Suc n)) = Leaf a b"|
"vebt_delete (Node None deg treeList summary) _ = (Node None deg treeList summary)"|
"vebt_delete (Node (Some (mi, ma)) 0 trLst smry) x = (Node (Some (mi, ma)) 0 trLst smry) "|
"vebt_delete (Node (Some (mi, ma)) (Suc 0) tr sm) x = (Node (Some (mi, ma)) (Suc 0) tr sm) "|
"vebt_delete (Node (Some (mi, ma)) deg treeList summary) x =(
if (x < mi ∨ x > ma) then (Node (Some (mi, ma)) deg treeList summary)
else if (x = mi ∧ x = ma) then (Node None deg treeList summary)
else let xn = (if x = mi
then the (vebt_mint summary) * 2^(deg div 2)
+ the (vebt_mint (treeList ! the (vebt_mint summary)))
else x);
minn = (if x = mi then xn else mi);
l = low xn (deg div 2);
h = high xn (deg div 2) in
if h < length treeList
then(
let newnode = vebt_delete (treeList ! h) l;
newlist = treeList[h:= newnode]in
if minNull newnode
then( let sn = vebt_delete summary h in(
Node (Some (minn, if xn = ma then
(let maxs = vebt_maxt sn in (
if maxs = None
then minn
else 2^(deg div 2) * the maxs
+ the (vebt_maxt (newlist ! the maxs))))
else ma)) deg newlist sn))
else (Node (Some (minn, (if xn = ma
then h * 2^(deg div 2) + the( vebt_maxt (newlist ! h))
else ma))) deg newlist summary ))
else (Node (Some (mi, ma)) deg treeList summary))"
end
subsection ‹Auxiliary Lemmas›
context VEBT_internal begin
context begin
lemma delt_out_of_range:
assumes "x < mi ∨ x > ma" and "deg ≥ 2"
shows
"vebt_delete (Node (Some (mi, ma)) deg treeList summary) x =(Node (Some (mi, ma)) deg treeList summary)"
using vebt_delete.simps(7)[of mi ma "deg-2" treeList summary x]
by (metis add_2_eq_Suc assms(1) assms(2) le_add_diff_inverse)
lemma del_single_cont:
assumes "x = mi ∧ x = ma" and "deg ≥ 2"
shows "vebt_delete (Node (Some (mi, ma)) deg treeList summary) x = (Node None deg treeList summary)"
using vebt_delete.simps(7)[of mi ma "deg-2" treeList summary x]
by (metis add_2_eq_Suc assms(1) assms(2) le_add_diff_inverse nat_less_le)
lemma del_in_range:
assumes "x ≥ mi ∧ x ≤ ma" and "mi ≠ ma" and "deg ≥ 2"
shows
" vebt_delete (Node (Some (mi, ma)) deg treeList summary) x = ( let xn = (if x = mi
then the (vebt_mint summary) * 2^(deg div 2)
+ the (vebt_mint (treeList ! the (vebt_mint summary)))
else x);
minn = (if x = mi then xn else mi);
l = low xn (deg div 2);
h = high xn (deg div 2) in
if h < length treeList
then(
let newnode = vebt_delete (treeList ! h) l;
newlist = treeList[h:= newnode] in
if minNull newnode
then(
let sn = vebt_delete summary h in
(Node (Some (minn, if xn = ma then (let maxs = vebt_maxt sn in
(if maxs = None
then minn
else 2^(deg div 2) * the maxs
+ the (vebt_maxt (newlist ! the maxs))
)
)
else ma))
deg newlist sn)
)else
(Node (Some (minn, (if xn = ma then
h * 2^(deg div 2) + the( vebt_maxt (newlist ! h))
else ma)))
deg newlist summary )
)else
(Node (Some (mi, ma)) deg treeList summary))"
using vebt_delete.simps(7)[of mi ma "deg-2" treeList summary x]
by (smt (z3) add_2_eq_Suc assms(1) assms(2) assms(3) leD le_add_diff_inverse)
lemma del_x_not_mia:
assumes "x > mi ∧ x ≤ ma" and "mi ≠ ma" and "deg ≥ 2" and "high x (deg div 2) = h" and
"low x (deg div 2) = l"and "high x (deg div 2) < length treeList"
shows
" vebt_delete (Node (Some (mi, ma)) deg treeList summary) x = (
let newnode = vebt_delete (treeList ! h) l;
newlist = treeList[h:= newnode] in
if minNull newnode
then(
let sn = vebt_delete summary h in
(Node (Some (mi, if x = ma then (let maxs = vebt_maxt sn in
(if maxs = None
then mi
else 2^(deg div 2) * the maxs
+ the (vebt_maxt (newlist ! the maxs))
)
)
else ma))
deg newlist sn)
)else
(Node (Some (mi, (if x = ma then
h * 2^(deg div 2) + the( vebt_maxt (newlist ! h))
else ma)))
deg newlist summary )
)"
using del_in_range[of mi x ma deg treeList summary] unfolding Let_def
using assms(1) assms(2) assms(3) assms(4) assms(5) assms(6) nat_less_le by fastforce
lemma del_x_not_mi:
assumes "x > mi ∧ x ≤ ma" and "mi ≠ ma" and "deg ≥ 2" and "high x (deg div 2) = h" and
"low x (deg div 2) = l"and " newnode = vebt_delete (treeList ! h) l"
and "newlist = treeList[h:= newnode]" and "high x (deg div 2) < length treeList"
shows
" vebt_delete (Node (Some (mi, ma)) deg treeList summary) x = (
if minNull newnode
then(
let sn = vebt_delete summary h in
(Node (Some (mi, if x = ma then (let maxs = vebt_maxt sn in
(if maxs = None
then mi
else 2^(deg div 2) * the maxs
+ the (vebt_maxt (newlist ! the maxs))
)
)
else ma))
deg newlist sn)
)else
(Node (Some (mi, (if x = ma then
h * 2^(deg div 2) + the( vebt_maxt (newlist ! h))
else ma)))
deg newlist summary )
)" using del_x_not_mia[of mi x ma deg h l treeList summary]
by (smt (z3) assms(1) assms(2) assms(3) assms(4) assms(5) assms(6) assms(7) assms(8))
lemma del_x_not_mi_new_node_nil:
assumes "x > mi ∧ x ≤ ma" and "mi ≠ ma" and "deg ≥ 2" and "high x (deg div 2) = h" and
"low x (deg div 2) = l"and " newnode = vebt_delete (treeList ! h) l" and "minNull newnode " and
"sn = vebt_delete summary h" and "newlist =treeList[h:= newnode]" and "high x (deg div 2) < length treeList"
shows
" vebt_delete (Node (Some (mi, ma)) deg treeList summary) x = (Node (Some (mi, if x = ma then (let maxs = vebt_maxt sn in
(if maxs = None
then mi
else 2^(deg div 2) * the maxs
+ the (vebt_maxt (newlist ! the maxs))
)
)
else ma)) deg newlist sn)"
using del_x_not_mi[of mi x ma deg h l newnode treeList]
by (metis assms(1) assms(10) assms(2) assms(3) assms(4) assms(5) assms(6) assms(7) assms(8) assms(9))
lemma del_x_not_mi_newnode_not_nil:
assumes "x > mi ∧ x ≤ ma" and "mi ≠ ma" and "deg ≥ 2" and "high x (deg div 2) = h" and
"low x (deg div 2) = l"and " newnode = vebt_delete (treeList ! h) l" and "¬ minNull newnode " and
"newlist = treeList[h:= newnode]" and"high x (deg div 2) < length treeList"
shows
" vebt_delete (Node (Some (mi, ma)) deg treeList summary) x =
(Node (Some (mi, (if x = ma then
h * 2^(deg div 2) + the( vebt_maxt (newlist ! h))
else ma)))
deg newlist summary )"
using del_x_not_mi[of mi x ma deg h l newnode treeList newlist summary]
using assms(1) assms(2) assms(3) assms(4) assms(5) assms(6) assms(7) assms(8) assms(9) by auto
lemma del_x_mia: assumes "x = mi ∧ x < ma" and "mi ≠ ma" and "deg ≥ 2"
shows "vebt_delete (Node (Some (mi, ma)) deg treeList summary) x =(
let xn = the (vebt_mint summary) * 2^(deg div 2)
+ the (vebt_mint (treeList ! the (vebt_mint summary)));
minn = xn;
l = low xn (deg div 2);
h = high xn (deg div 2) in
if h < length treeList
then(
let newnode = vebt_delete (treeList ! h) l;
newlist = treeList[h:= newnode]in
if minNull newnode
then(
let sn = vebt_delete summary h in
(Node (Some (minn, if xn = ma then (let maxs = vebt_maxt sn in
(if maxs = None
then minn
else 2^(deg div 2) * the maxs
+ the (vebt_maxt (newlist ! the maxs))
)
)
else ma))
deg newlist sn)
)else
(Node (Some (minn, (if xn = ma then
h * 2^(deg div 2) + the( vebt_maxt (newlist ! h))
else ma)))
deg newlist summary )
)else
(Node (Some (mi, ma)) deg treeList summary)
)"
using del_in_range[of mi x ma deg treeList summary]
using assms(1) assms(3) nat_less_le order_refl by fastforce
lemma del_x_mi:
assumes "x = mi ∧ x < ma" and "mi ≠ ma" and "deg ≥ 2" and "high xn (deg div 2) = h" and
"xn = the (vebt_mint summary) * 2^(deg div 2) + the (vebt_mint (treeList ! the (vebt_mint summary))) "
"low xn (deg div 2) = l"and "high xn (deg div 2) < length treeList"
shows
"vebt_delete (Node (Some (mi, ma)) deg treeList summary) x =(
let newnode = vebt_delete (treeList ! h) l;
newlist = treeList[h:= newnode]in
if minNull newnode
then(
let sn = vebt_delete summary h in
(Node (Some (xn, if xn = ma then (let maxs = vebt_maxt sn in
(if maxs = None
then xn
else 2^(deg div 2) * the maxs
+ the (vebt_maxt (newlist ! the maxs))
)
)
else ma))
deg newlist sn)
)else
(Node (Some (xn, (if xn = ma then
h * 2^(deg div 2) + the( vebt_maxt (newlist ! h))
else ma)))
deg newlist summary ))
"
using del_x_mia[of x mi ma deg treeList summary]
by (smt (z3) assms(1) assms(2) assms(3) assms(4) assms(5) assms(6) assms(7))
lemma del_x_mi_lets_in:
assumes "x = mi ∧ x < ma" and "mi ≠ ma" and "deg ≥ 2" and "high xn (deg div 2) = h" and
"xn = the (vebt_mint summary) * 2^(deg div 2) + the (vebt_mint (treeList ! the (vebt_mint summary))) "
"low xn (deg div 2) = l"and "high xn (deg div 2) < length treeList" and
" newnode = vebt_delete (treeList ! h) l" and " newlist = treeList[h:= newnode]"
shows "vebt_delete (Node (Some (mi, ma)) deg treeList summary) x =( if minNull newnode
then(
let sn = vebt_delete summary h in
(Node (Some (xn, if xn = ma then (let maxs = vebt_maxt sn in
(if maxs = None
then xn
else 2^(deg div 2) * the maxs
+ the (vebt_maxt (newlist ! the maxs))
)
)
else ma))
deg newlist sn)
)else
(Node (Some (xn, (if xn = ma then
h * 2^(deg div 2) + the( vebt_maxt (newlist ! h))
else ma)))
deg newlist summary ))"
using del_x_mi[of x mi ma deg xn h summary treeList l]
by (smt (z3) assms(1) assms(2) assms(3) assms(4) assms(5) assms(6) assms(7) assms(8) assms(9))
lemma del_x_mi_lets_in_minNull:
assumes "x = mi ∧ x < ma" and "mi ≠ ma" and "deg ≥ 2" and "high xn (deg div 2) = h" and
"xn = the (vebt_mint summary) * 2^(deg div 2) + the (vebt_mint (treeList ! the (vebt_mint summary))) "
"low xn (deg div 2) = l"and "high xn (deg div 2) < length treeList" and
"newnode = vebt_delete (treeList ! h) l" and " newlist =treeList[h:= newnode]" and
"minNull newnode " and " sn = vebt_delete summary h"
shows
"vebt_delete (Node (Some (mi, ma)) deg treeList summary) x =
(Node (Some (xn, if xn = ma then (let maxs = vebt_maxt sn in
(if maxs = None
then xn
else 2^(deg div 2) * the maxs
+ the (vebt_maxt (newlist ! the maxs))
)
)
else ma)) deg newlist sn)"
using del_x_mi_lets_in[of x mi ma deg xn h summary treeList l newnode newlist]
by (metis assms(1) assms(10) assms(11) assms(2) assms(3) assms(4) assms(5) assms(6) assms(7) assms(8) assms(9))
lemma del_x_mi_lets_in_not_minNull:
assumes "x = mi ∧ x < ma" and "mi ≠ ma" and "deg ≥ 2" and "high xn (deg div 2) = h" and
"xn = the (vebt_mint summary) * 2^(deg div 2) + the (vebt_mint (treeList ! the (vebt_mint summary))) "
"low xn (deg div 2) = l"and "high xn (deg div 2) < length treeList" and
" newnode = vebt_delete (treeList ! h) l" and " newlist = treeList[h:= newnode]" and
"¬minNull newnode "
shows
"vebt_delete (Node (Some (mi, ma)) deg treeList summary) x =
(Node (Some (xn, (if xn = ma then
h * 2^(deg div 2) + the( vebt_maxt (newlist ! h))
else ma)))
deg newlist summary )"
using del_x_mi_lets_in[of x mi ma deg xn h summary treeList l newnode newlist]
by (meson assms(1) assms(10) assms(2) assms(3) assms(4) assms(5) assms(6) assms(7) assms(8) assms(9))
theorem dele_bmo_cont_corr:"invar_vebt t n ⟹ (both_member_options (vebt_delete t x) y ⟷ x ≠ y ∧ both_member_options t y)"
proof(induction t n arbitrary: x y rule: invar_vebt.induct)
case (1 a b)
have "(both_member_options (vebt_delete (Leaf a b) x) y) ⟹ (x ≠ y ∧ both_member_options (Leaf a b) y)"
by (metis One_nat_def both_member_options_def vebt_buildup.cases vebt_delete.simps(1) vebt_delete.simps(2) vebt_delete.simps(3) membermima.simps(1) naive_member.simps(1))
moreover have "(x ≠ y ∧ both_member_options (Leaf a b) y) ⟹(both_member_options (vebt_delete (Leaf a b) x) y)"
by (metis One_nat_def both_member_options_def vebt_buildup.cases vebt_delete.simps(1) vebt_delete.simps(2) vebt_delete.simps(3) membermima.simps(1) naive_member.simps(1))
ultimately show ?case by blast
next
case (2 treeList n summary m deg)
hence "deg ≥ 2"
by (metis Suc_leI deg_not_0 dual_order.strict_trans2 less_add_same_cancel1 numerals(2))
hence " (vebt_delete (Node None deg treeList summary) x) = (Node None deg treeList summary)" by simp
moreover have "¬vebt_member (Node None deg treeList summary) y" by simp
moreover hence "¬both_member_options (Node None deg treeList summary) y"
using invar_vebt.intros(2)[of treeList n summary m deg] 2
by (metis valid_member_both_member_options)
moreover hence "¬both_member_options (vebt_delete (Node None deg treeList summary) x) y" by simp
ultimately show ?case
by force
next
case (3 treeList n summary m deg)
hence "deg ≥ 2"
by (metis One_nat_def add_mono le_add1 numeral_2_eq_2 plus_1_eq_Suc set_n_deg_not_0)
hence " (vebt_delete (Node None deg treeList summary) x) = (Node None deg treeList summary)" by simp
moreover have "¬vebt_member (Node None deg treeList summary) y" by simp
moreover hence "¬both_member_options (Node None deg treeList summary) y"
using invar_vebt.intros(3)[of treeList n summary m deg] 3
by (metis valid_member_both_member_options)
moreover hence "¬both_member_options (vebt_delete (Node None deg treeList summary) x) y" by simp
ultimately show ?case
by force
next
case (4 treeList n summary m deg mi ma)
hence tvalid: "invar_vebt (Node (Some (mi, ma)) deg treeList summary) deg"
using invar_vebt.intros(4)[of treeList n summary m deg mi ma] by simp
hence "mi ≤ ma" and "deg div 2 = n" and "ma ≤ 2^deg" using 4
by (auto simp add: "4.hyps"(3) "4.hyps"(4))
hence dp:"deg ≥ 2"
using "4.hyps"(1) "4.hyps"(3) deg_not_0 div_greater_zero_iff by blast
then show ?case proof(cases "x <mi ∨ x > ma")
case True
hence "vebt_delete (Node (Some (mi, ma)) deg treeList summary) x = (Node (Some (mi, ma)) deg treeList summary)"
using delt_out_of_range[of x mi ma deg treeList summary] ‹2 ≤ deg› by blast
then show ?thesis
by (metis "4.hyps"(7) True tvalid leD member_inv not_less_iff_gr_or_eq valid_member_both_member_options)
next
case False
hence "mi ≤ x ∧ x ≤ ma" by simp
hence "x < 2^deg"
using "4.hyps"(8) order.strict_trans1 by blast
then show ?thesis
proof(cases "x = mi ∧ x = ma")
case True
hence "vebt_delete (Node (Some (mi, ma)) deg treeList summary) x = (Node None deg treeList summary)"
using del_single_cont[of x mi ma deg treeList summary] ‹2 ≤ deg› by blast
moreover hence "invar_vebt (Node None deg treeList summary) deg"
using "4"(4) "4.IH"(1) "4.hyps"(1) "4.hyps"(3) "4.hyps"(4) True mi_eq_ma_no_ch tvalid invar_vebt.intros(2) by force
moreover hence "¬ vebt_member (Node None deg treeList summary) y" by simp
moreover hence "¬both_member_options (Node None deg treeList summary) y"
using calculation(2) valid_member_both_member_options by blast
then show ?thesis
by (metis True calculation(1) member_inv not_less_iff_gr_or_eq tvalid valid_member_both_member_options)
next
case False
hence mimapr:"mi < ma"
by (metis "4.hyps"(7) ‹mi ≤ x ∧ x ≤ ma› le_antisym nat_less_le)
then show ?thesis
proof(cases "x ≠ mi")
case True
hence xmi:"x ≠ mi" by simp
let ?h ="high x n"
let ?l = "low x n"
have "?h < length treeList"
using "4"(10) "4"(4) "4.hyps"(1) "4.hyps"(3) "4.hyps"(4) ‹mi ≤ x ∧ x ≤ ma› deg_not_0 exp_split_high_low(1) by auto
let ?newnode = "vebt_delete (treeList ! ?h) ?l"
let ?newlist = "treeList[?h:= ?newnode]"
have "length treeList = length ?newlist" by simp
hence hprolist: "?newlist ! ?h = ?newnode"
by (meson ‹high x n < length treeList› nth_list_update_eq)
have nothprolist: "i ≠ ?h ∧ i < 2^m ⟹ ?newlist ! i = treeList ! i" for i by auto
then show ?thesis
proof(cases "minNull ?newnode")
case True
let ?sn = "vebt_delete summary ?h"
let ?newma= "(if x = ma then (let maxs = vebt_maxt ?sn in (if maxs = None
then mi
else 2^(deg div 2) * the maxs
+ the (vebt_maxt (?newlist ! the maxs))
)
)
else ma)"
let ?delsimp =" (Node (Some (mi, ?newma)) deg ?newlist ?sn)"
have "vebt_delete (Node (Some (mi, ma)) deg treeList summary) x = ?delsimp"
using del_x_not_mi_new_node_nil[of mi x ma deg ?h ?l ?newnode treeList ?sn summary ?newlist]
by (metis True ‹2 ≤ deg› ‹deg div 2 = n› ‹high x n < length treeList› ‹mi < ma› ‹mi ≤ x ∧ x ≤ ma› ‹x ≠ mi› less_not_refl3 order.not_eq_order_implies_strict)
moreover have "both_member_options (?delsimp) y ⟹ (x ≠ y ∧ both_member_options (Node (Some (mi, ma)) deg treeList summary) y)"
proof-
assume "both_member_options (?delsimp) y"
hence "y = mi ∨ y = ?newma ∨
(both_member_options (?newlist ! (high y (deg div 2))) (low y (deg div 2)) ∧ (high y (deg div 2)) < length ?newlist)"
using both_member_options_from_complete_tree_to_child[of deg mi ?newma ?newlist ?sn y] dp
by (smt (z3) Suc_1 Suc_le_D both_member_options_def membermima.simps(4) naive_member.simps(3))
moreover have "y = mi ⟹ ?thesis"
by (meson ‹x ≠ mi› both_member_options_equiv_member vebt_mint.simps(3) mint_member tvalid)
moreover have "y = ?newma ⟹ ?thesis"
proof-
assume "y = ?newma"
show ?thesis
proof(cases "x = ma")
case True
let ?maxs = "vebt_maxt ?sn"
have "?newma = (if ?maxs = None then mi
else 2 ^ (deg div 2) * the ?maxs + the (vebt_maxt
((treeList[(high x n):= vebt_delete (treeList ! (high x n)) (low x n)]) !
the ?maxs)))" using True by force
then show ?thesis
proof(cases "?maxs = None ")
case True
then show ?thesis
using ‹(if x = ma then let maxs = vebt_maxt (vebt_delete summary (high x n)) in if maxs = None then mi else 2 ^ (deg div 2) * the maxs + the (vebt_maxt (treeList [high x n := vebt_delete (treeList ! high x n) (low x n)] ! the maxs)) else ma) = (if vebt_maxt (vebt_delete summary (high x n)) = None then mi else 2 ^ (deg div 2) * the (vebt_maxt (vebt_delete summary (high x n))) + the (vebt_maxt (treeList[high x n := vebt_delete (treeList ! high x n) (low x n)] ! the (vebt_maxt (vebt_delete summary (high x n))))))› ‹y = (if x = ma then let maxs = vebt_maxt (vebt_delete summary (high x n)) in if maxs = None then mi else 2 ^ (deg div 2) * the maxs + the (vebt_maxt (treeList [high x n := vebt_delete (treeList ! high x n) (low x n)] ! the maxs)) else ma)› calculation(2) by presburger
next
case False
then obtain maxs where "Some maxs = ?maxs" by force
hence "both_member_options ?sn maxs"
by (simp add: maxbmo)
hence "both_member_options summary maxs ∧ maxs ≠ ?h"
using "4.IH"(2) by blast
hence "?newlist ! the ?maxs = treeList ! maxs"
by (metis "4.hyps"(1) ‹Some maxs = vebt_maxt (vebt_delete summary (high x n))› option.sel member_bound nothprolist valid_member_both_member_options)
have "maxs < 2^m"
using "4.hyps"(1) ‹both_member_options summary maxs ∧ maxs ≠ high x n› member_bound valid_member_both_member_options by blast
hence "the (vebt_maxt (?newlist ! the ?maxs)) = the (vebt_maxt (treeList ! maxs))"
by (simp add: ‹treeList[high x n := vebt_delete (treeList ! high x n) (low x n)] ! the (vebt_maxt (vebt_delete summary (high x n))) = treeList ! maxs›)
have "∃ z. both_member_options(treeList ! maxs) z"
by (simp add: "4.hyps"(5) ‹both_member_options summary maxs ∧ maxs ≠ high x n› ‹maxs < 2 ^ m›)
moreover have "invar_vebt (treeList ! maxs) n" using 4
by (metis ‹maxs < 2 ^ m› inthall member_def)
ultimately obtain maxi where "Some maxi = (vebt_maxt (treeList ! maxs))"
by (metis empty_Collect_eq maxt_corr_help_empty not_None_eq set_vebt'_def valid_member_both_member_options)
hence "maxi < 2^n"
by (metis ‹invar_vebt (treeList ! maxs) n› maxt_member member_bound)
hence "both_member_options (treeList ! maxs) maxi"
using ‹Some maxi = vebt_maxt (treeList ! maxs)› maxbmo by presburger
hence "2 ^ (deg div 2) * the ?maxs + the
(vebt_maxt (?newlist ! the ?maxs)) = 2^n * maxs + maxi "
by (metis ‹Some maxi = vebt_maxt (treeList ! maxs)› ‹Some maxs = vebt_maxt (vebt_delete summary (high x n))› ‹deg div 2 = n› ‹the (vebt_maxt (treeList[high x n := vebt_delete (treeList ! high x n) (low x n)] ! the (vebt_maxt (vebt_delete summary (high x n))))) = the (vebt_maxt (treeList ! maxs))› option.sel)
hence "y = 2^n * maxs + maxi"
using False True ‹y = (if x = ma then let maxs = vebt_maxt (vebt_delete summary (high x n)) in if maxs = None then mi else 2 ^ (deg div 2) * the maxs + the (vebt_maxt (treeList [high x n := vebt_delete (treeList ! high x n) (low x n)] ! the maxs)) else ma)› by fastforce
hence "both_member_options (Node (Some (mi, ma)) deg treeList summary) y"
by (metis "4.hyps"(2) Suc_1 ‹both_member_options (treeList ! maxs) maxi› ‹deg div 2 = n› ‹maxi < 2 ^ n› ‹maxs < 2 ^ m› add_leD1 both_member_options_from_chilf_to_complete_tree dp high_inv low_inv mult.commute plus_1_eq_Suc)
moreover hence "y ≠ x"
by (metis ‹both_member_options summary maxs ∧ maxs ≠ high x n› ‹maxi < 2 ^ n› ‹y = 2 ^ n * maxs + maxi› high_inv mult.commute)
ultimately show ?thesis by force
qed
next
case False
hence "?newma = ma" by simp
moreover hence "y ≠ x"
using False ‹y = ?newma› by presburger
then show ?thesis
by (metis False ‹y =?newma› both_member_options_equiv_member vebt_maxt.simps(3) maxt_member tvalid)
qed
qed
moreover have "(both_member_options (?newlist ! (high y (deg div 2))) (low y (deg div 2)) ∧ (high y (deg div 2)) < length ?newlist) ⟹ ?thesis"
proof-
assume assm:"both_member_options (?newlist ! (high y (deg div 2))) (low y (deg div 2)) ∧ (high y (deg div 2)) < length ?newlist"
show ?thesis
proof(cases "(high y (deg div 2)) = ?h")
case True
hence "both_member_options ?newnode (low y (deg div 2)) " using hprolist by (metis assm)
moreover hence "invar_vebt (treeList ! (high y (deg div 2))) n"
by (metis "4.IH"(1) True ‹high x n < length treeList› inthall member_def)
ultimately have "both_member_options (treeList ! ?h) (low y (deg div 2)) ∧ (low y (deg div 2)) ≠ (low x (deg div 2))"
by (metis "4.IH"(1) ‹deg div 2 = n› ‹high x n < length treeList› inthall member_def)
then show ?thesis
by (metis Suc_1 True ‹high x n < length treeList› add_leD1 both_member_options_from_chilf_to_complete_tree dp plus_1_eq_Suc)
next
case False
hence "x ≠ y"
using ‹deg div 2 = n› by blast
moreover hence "(?newlist ! (high y (deg div 2))) = treeList ! (high y (deg div 2))" using nothprolist
using "4.hyps"(2) False ‹length treeList = length ?newlist› assm by presburger
moreover hence "both_member_options (treeList ! (high y (deg div 2)) ) (low y (deg div 2))"
using assm by presburger
moreover hence "both_member_options (Node (Some (mi, ma)) deg treeList summary) y"
by (metis One_nat_def Suc_leD ‹length treeList = length ?newlist› assm both_member_options_from_chilf_to_complete_tree dp numeral_2_eq_2)
ultimately show ?thesis by blast
qed
qed
ultimately show ?thesis by fastforce
qed
moreover have " (x ≠ y ∧ both_member_options (Node (Some (mi, ma)) deg treeList summary) y) ⟹ both_member_options (?delsimp) y"
proof-
assume "(x ≠ y ∧ both_member_options (Node (Some (mi, ma)) deg treeList summary) y)"
hence aa:"x ≠ y" and bb:"y = mi ∨ y = ma ∨ (both_member_options (treeList ! (high y n)) (low y n) ∧ high y n < length treeList)"
apply auto[1] by (metis Suc_1 ‹deg div 2 = n› ‹x ≠ y ∧ both_member_options (Node (Some (mi, ma)) deg treeList summary) y› add_leD1 both_member_options_from_complete_tree_to_child member_inv plus_1_eq_Suc tvalid valid_member_both_member_options)
show "both_member_options (?delsimp) y"
proof-
have "y = mi ⟹both_member_options (?delsimp) y"
by (metis Suc_1 Suc_le_D both_member_options_def dp membermima.simps(4))
moreover have "y = ma ⟹ both_member_options (?delsimp) y"
using aa maxbmo vebt_maxt.simps(3) by presburger
moreover have "both_member_options (treeList ! (high y n)) (low y n) ⟹both_member_options (?delsimp) y "
proof-
assume assmy: "both_member_options (treeList ! (high y n)) (low y n)"
then show "both_member_options (?delsimp) y "
proof(cases "high y n = ?h")
case True
moreover hence "?newlist ! (high y n) = ?newnode"
using hprolist by auto
hence 0:"invar_vebt (treeList !(high y n)) n" using 4
by (metis True ‹high x n < length treeList› inthall member_def)
moreover have 1:"low y n ≠ low x n"
by (metis True aa bit_split_inv)
moreover have 11:" (treeList !(high y n)) ∈ set treeList"
by (metis True ‹high x n < length treeList› inthall member_def)
ultimately have " (∀ xa. both_member_options ?newnode xa =
((low x n) ≠ xa ∧ both_member_options (treeList ! ?h) xa))"
by (simp add: "4.IH"(1))
hence "((low x n) ≠ xa ∧ both_member_options (treeList ! ?h) xa) ⟹ both_member_options ?newnode xa" for xa by blast
moreover have "((low x n) ≠ (low y n) ∧ both_member_options (treeList ! ?h) (low y n))" using 1
using True assmy by presburger
ultimately have "both_member_options ?newnode (low y n)" by blast
then show ?thesis
by (metis One_nat_def Suc_leD True ‹deg div 2 = n› ‹high x n < length treeList› ‹length treeList = length ?newlist› both_member_options_from_chilf_to_complete_tree dp hprolist numerals(2))
next
case False
hence "?newlist ! (high y n) = treeList ! (high y n)" by auto
hence "both_member_options (?newlist !(high y n)) (low y n)"
using assmy by presburger
then show ?thesis
by (smt (z3) Suc_1 Suc_le_D ‹deg div 2 = n› ‹length treeList = length ?newlist› aa add_leD1 bb both_member_options_def both_member_options_from_chilf_to_complete_tree dp membermima.simps(4) plus_1_eq_Suc)
qed
qed
ultimately show ?thesis using bb by fastforce
qed
qed
ultimately show ?thesis by metis
next
case False
hence notemp:"∃ z. both_member_options ?newnode z"
using not_min_Null_member by auto
let ?newma = "(if x = ma then
?h * 2^(deg div 2) + the( vebt_maxt (?newlist ! ?h))
else ma)"
let ?delsimp =" (Node (Some (mi, ?newma)) deg ?newlist summary)"
have "vebt_delete (Node (Some (mi, ma)) deg treeList summary) x = ?delsimp"
using del_x_not_mi_newnode_not_nil[of mi x ma deg ?h ?l ?newnode treeList ?newlist summary] False xmi mimapr
using ‹deg div 2 = n› ‹high x n < length treeList› ‹mi ≤ x ∧ x ≤ ma› dp nat_less_le plus_1_eq_Suc by fastforce
moreover have "both_member_options ?delsimp y
⟹ x ≠ y ∧ both_member_options (Node (Some (mi, ma)) deg treeList summary) y"
proof-
assume ssms: "both_member_options ?delsimp y "
hence aaaa: "y = mi ∨ y = ?newma ∨ (both_member_options (?newlist ! (high y n)) (low y n) ∧ high y n < length ?newlist)"
by (smt (z3) Suc_1 Suc_le_D ‹deg div 2 = n› both_member_options_def dp membermima.simps(4) naive_member.simps(3))
show " x ≠ y ∧ both_member_options (Node (Some (mi, ma)) deg treeList summary) y"
proof-
have "y = mi ⟹?thesis"
by (metis Suc_1 Suc_le_D both_member_options_def dp membermima.simps(4) xmi)
moreover have " y = ?newma ⟹ ?thesis"
proof-
assume "y = ?newma"
show ?thesis
proof(cases "x = ma")
case True
hence "?newma =?h * 2 ^ (deg div 2) +the(vebt_maxt(?newlist ! ?h))"
by metis
have "?newlist ! ?h = ?newnode" using hprolist by blast
obtain maxi where maxidef:"Some maxi = vebt_maxt(?newlist ! ?h)"
by (metis False hprolist vebt_maxt.elims minNull.simps(1) minNull.simps(4))
have aa:"invar_vebt (treeList ! ?h) n"
by (metis "4.IH"(1) ‹high x n < length treeList› inthall member_def)
moreover hence ab:"maxi ≠ ?l ∧ both_member_options ?newnode maxi"
by (metis "4.IH"(1) ‹high x n < length treeList› hprolist inthall maxbmo maxidef member_def)
ultimately have ac:"maxi ≠ ?l ∧ both_member_options (treeList ! ?h) maxi"
by (metis "4.IH"(1) ‹high x n < length treeList› inthall member_def)
hence ad:"maxi < 2^n"
using ‹invar_vebt (treeList ! high x n) n› member_bound valid_member_both_member_options by blast
then show ?thesis
by (metis Suc_1 ‹(if x = ma then high x n * 2 ^ (deg div 2) + the (vebt_maxt (treeList[high x n := vebt_delete (treeList ! high x n) (low x n)] ! high x n)) else ma) = high x n * 2 ^ (deg div 2) + the (vebt_maxt (treeList[high x n := vebt_delete (treeList ! high x n) (low x n)] ! high x n))› ‹deg div 2 = n› ‹high x n < length treeList› ‹y = (if x = ma then high x n * 2 ^ (deg div 2) + the (vebt_maxt (treeList[high x n := vebt_delete (treeList ! high x n) (low x n)] ! high x n)) else ma)› ac add_leD1 both_member_options_from_chilf_to_complete_tree dp option.sel high_inv low_inv maxidef plus_1_eq_Suc)
next
case False
then show ?thesis
by (simp add: ‹y = ?newma› maxbmo)
qed
qed
moreover have "both_member_options (?newlist ! (high y n)) (low y n) ⟹ ?thesis"
proof-
assume assmy:"both_member_options (?newlist ! (high y n)) (low y n)"
then show ?thesis
proof(cases "high y n = ?h")
case True
hence "?newlist ! (high y n) = ?newnode"
using hprolist by presburger
have "invar_vebt (treeList ! ?h) n"
by (metis "4.IH"(1) ‹high x n < length treeList› inthall member_def)
hence "low y n ≠ ?l ∧ both_member_options (treeList ! ?h ) (low y n)"
by (metis "4.IH"(1) True ‹high x n < length treeList› assmy hprolist inthall member_def)
then show ?thesis
by (metis Suc_1 True ‹deg div 2 = n› ‹high x n < length treeList› add_leD1 both_member_options_from_chilf_to_complete_tree dp plus_1_eq_Suc)
next
case False
hence "?newlist ! (high y n) = treeList !(high y n)" by auto
then show ?thesis
by (metis False Suc_1 ‹deg div 2 = n› ‹length treeList = length ?newlist› aaaa add_leD1 both_member_options_from_chilf_to_complete_tree calculation(1) calculation(2) dp plus_1_eq_Suc)
qed
qed
ultimately show ?thesis
using aaaa by fastforce
qed
qed
moreover have "(x ≠ y ∧ both_member_options (Node (Some (mi, ma)) deg treeList summary) y)⟹
both_member_options ?delsimp y"
proof-
assume assm: "x ≠ y ∧ both_member_options (Node (Some (mi, ma)) deg treeList summary) y"
hence abcv:"y = mi ∨ y = ma ∨ ( high y n < length treeList ∧ both_member_options (treeList ! (high y n)) (low y n))"
by (metis Suc_1 ‹deg div 2 = n› add_leD1 both_member_options_from_complete_tree_to_child member_inv plus_1_eq_Suc tvalid valid_member_both_member_options)
thus " both_member_options ?delsimp y"
proof-
have "y = mi ⟹ ?thesis"
by (metis Suc_1 Suc_le_D both_member_options_def dp membermima.simps(4))
moreover have " y = ma ⟹ ?thesis"
using assm maxbmo vebt_maxt.simps(3) by presburger
moreover have " both_member_options (treeList ! (high y n)) (low y n) ⟹ ?thesis"
proof-
assume myass: "both_member_options (treeList ! (high y n)) (low y n) "
thus ?thesis
proof(cases "high y n = ?h")
case True
hence "low y n ≠ ?l"
by (metis assm bit_split_inv)
hence pp:"?newlist ! ?h = ?newnode"
using hprolist by blast
hence "invar_vebt (treeList ! ?h) n"
by (metis "4.IH"(1) ‹high x n < length treeList› inthall member_def)
hence "both_member_options ?newnode (low y n)"
by (metis "4.IH"(1) True ‹high x n < length treeList› ‹low y n ≠ low x n› in_set_member inthall myass)
then show ?thesis
by (metis One_nat_def Suc_leD True ‹deg div 2 = n› ‹high x n < length treeList› ‹length treeList = length ?newlist› both_member_options_from_chilf_to_complete_tree dp numerals(2) pp)
next
case False
hence pp:"?newlist ! (high y n) = treeList ! (high y n)" using nothprolist by auto
then show ?thesis
by (metis Suc_1 ‹deg div 2 = n› ‹length treeList = length (treeList[high x n := vebt_delete (treeList ! high x n) (low x n)])› add_leD1 assm both_member_options_from_chilf_to_complete_tree calculation(1) calculation(2) member_inv myass plus_1_eq_Suc tvalid valid_member_both_member_options)
qed
qed
then show ?thesis
by (metis Suc_1 Suc_leD ‹deg div 2 = n› assm both_member_options_from_complete_tree_to_child calculation(1) calculation(2) dp)
qed
qed
ultimately show ?thesis by metis
qed
next
case False
hence "x = mi" by simp
have "both_member_options summary (high ma n)"
by (metis "4"(10) "4"(11) "4"(7) "4.hyps"(4) Euclidean_Division.div_eq_0_iff Suc_leI Suc_le_D div_exp_eq dual_order.irrefl high_def mimapr nat.simps(3))
hence "vebt_member summary (high ma n)"
using "4.hyps"(1) valid_member_both_member_options by blast
obtain summin where "Some summin = vebt_mint summary"
by (metis "4.hyps"(1) ‹vebt_member summary (high ma n)› empty_Collect_eq mint_corr_help_empty not_None_eq set_vebt'_def)
hence "∃ z . both_member_options (treeList ! summin) z"
by (metis "4.hyps"(1) "4.hyps"(5) both_member_options_equiv_member member_bound mint_member)
moreover have "invar_vebt (treeList ! summin) n"
by (metis "4"(4) "4.IH"(1) "4.hyps"(1) ‹Some summin = vebt_mint summary› member_bound mint_member nth_mem)
ultimately obtain lx where "Some lx = vebt_mint (treeList ! summin)"
by (metis empty_Collect_eq mint_corr_help_empty not_None_eq set_vebt'_def valid_member_both_member_options)
let ?xn = "summin*2^n + lx"
have "?xn = (if x = mi
then the (vebt_mint summary) * 2^(deg div 2)
+ the (vebt_mint (treeList ! the (vebt_mint summary)))
else x)"
by (metis False ‹Some lx = vebt_mint (treeList ! summin)› ‹Some summin = vebt_mint summary› ‹deg div 2 = n› option.sel)
have "vebt_member (treeList ! summin) lx"
using ‹Some lx = vebt_mint (treeList ! summin)› ‹invar_vebt (treeList ! summin) n› mint_member by auto
moreover have "summin < 2^m"
by (metis "4.hyps"(1) ‹Some summin = vebt_mint summary› member_bound mint_member)
ultimately have xnin: "both_member_options (Node (Some (mi, ma)) deg treeList summary) ?xn"
by (metis "4.hyps"(2) Suc_1 ‹deg div 2 = n› ‹invar_vebt (treeList ! summin) n› add_leD1 both_member_options_equiv_member both_member_options_from_chilf_to_complete_tree dp high_inv low_inv member_bound plus_1_eq_Suc)
let ?h ="high ?xn n"
let ?l = "low ?xn n"
have "?xn < 2^deg"
by (smt (verit, ccfv_SIG) "4.hyps"(1) "4.hyps"(4) Euclidean_Division.div_eq_0_iff ‹Some lx = vebt_mint (treeList ! summin)› ‹Some summin = vebt_mint summary› ‹invar_vebt (treeList ! summin) n› div_exp_eq high_def high_inv le_0_eq member_bound mint_member not_numeral_le_zero power_not_zero)
hence "?h < length treeList"
using "4.hyps"(2) "4.hyps"(3) "4.hyps"(4) ‹invar_vebt (treeList ! summin) n› deg_not_0 exp_split_high_low(1) by metis
let ?newnode = "vebt_delete (treeList ! ?h) ?l"
let ?newlist = "treeList[?h:= ?newnode]"
have "length treeList = length ?newlist" by simp
hence hprolist: "?newlist ! ?h = ?newnode"
by (meson ‹high (summin * 2 ^ n + lx) n < length treeList› nth_list_update)
have nothprolist: "i ≠ ?h ∧ i < 2^m ⟹ ?newlist ! i = treeList ! i" for i by simp
have firstsimp: "vebt_delete (Node (Some (mi, ma)) deg treeList summary) x =(
let newnode = vebt_delete (treeList ! ?h) ?l;
newlist = (take ?h treeList @ [ newnode]@drop (?h+1) treeList)in
if minNull newnode
then(
let sn = vebt_delete summary ?h in
(Node (Some (?xn, if ?xn = ma then (let maxs = vebt_maxt sn in
(if maxs = None
then ?xn
else 2^(deg div 2) * the maxs
+ the (vebt_maxt (newlist ! the maxs))
)
)
else ma))
deg newlist sn)
)else
(Node (Some (?xn, (if ?xn = ma then
?h * 2^(deg div 2) + the( vebt_maxt (newlist ! ?h))
else ma)))
deg newlist summary ))"
using del_x_mi[of x mi ma deg ?xn ?h summary treeList ?l]
by (smt (z3) ‹deg div 2 = n› ‹high (summin * 2 ^ n + lx) n < length treeList› ‹summin * 2 ^ n + lx = (if x = mi then the (vebt_mint summary) * 2 ^ (deg div 2) + the (vebt_mint (treeList ! the (vebt_mint summary))) else x)› ‹x = mi› add.commute append_Cons append_Nil dp mimapr nat_less_le plus_1_eq_Suc upd_conv_take_nth_drop)
have minxnrel: "?xn ≠ mi"
by (metis "4.hyps"(2) "4.hyps"(9) ‹high (summin * 2 ^ n + lx) n < length treeList› ‹vebt_member (treeList ! summin) lx› ‹invar_vebt (treeList ! summin) n› both_member_options_equiv_member high_inv less_not_refl low_inv member_bound mimapr)
then show ?thesis
proof(cases "minNull ?newnode")
case True
let ?sn = "vebt_delete summary ?h"
let ?newma= "(if ?xn= ma then (let maxs = vebt_maxt ?sn in
(if maxs = None
then ?xn
else 2^(deg div 2) * the maxs
+ the (vebt_maxt (?newlist ! the maxs))
)
)
else ma)"
let ?delsimp =" (Node (Some (?xn, ?newma)) deg ?newlist ?sn)"
have "vebt_delete (Node (Some (mi, ma)) deg treeList summary) x = ?delsimp"
using del_x_mi_lets_in_minNull[of x mi ma deg ?xn ?h summary treeList ?l ?newnode ?newlist ?sn] False True ‹deg div 2 = n› ‹?h < length treeList› ‹summin * 2 ^ n + lx = (if x = mi then the (vebt_mint summary) * 2 ^ (deg div 2) + the (vebt_mint (treeList ! the (vebt_mint summary))) else x)› dp less_not_refl3 mimapr by fastforce
moreover have "both_member_options (?delsimp) y ⟹ (x ≠ y ∧ both_member_options (Node (Some (mi, ma)) deg treeList summary) y)"
proof-
assume "both_member_options (?delsimp) y"
hence "y = ?xn ∨ y = ?newma ∨
(both_member_options (?newlist ! (high y (deg div 2))) (low y (deg div 2)) ∧ (high y (deg div 2)) < length ?newlist)"
using both_member_options_from_complete_tree_to_child[of deg mi ?newma ?newlist ?sn y] dp
by (smt (z3) Suc_1 Suc_le_D both_member_options_def membermima.simps(4) naive_member.simps(3))
moreover have "y = ?xn ⟹ ?thesis"
by (metis "4.hyps"(9) False ‹vebt_member (treeList ! summin) lx› ‹summin < 2 ^ m› ‹invar_vebt (treeList ! summin) n› both_member_options_equiv_member high_inv less_not_refl low_inv member_bound mimapr xnin)
moreover have "y = ?newma ⟹ ?thesis"
proof-
assume asmt: "y = ?newma"
show ?thesis
proof(cases "?xn = ma")
case True
let ?maxs = "vebt_maxt ?sn"
have newmaext:"?newma = (if ?maxs = None then ?xn
else 2 ^ (deg div 2) * the ?maxs + the (vebt_maxt
( ?newlist ! the ?maxs)))" using True by force
then show ?thesis
proof(cases "?maxs = None ")
case True
hence aa:"?newma = ?xn" using newmaext by auto
hence bb: "?newma ≠ x"
using False minxnrel by presburger
hence "both_member_options (Node (Some (mi, ma)) deg treeList summary) ?xn"
using xnin newmaext minxnrel asmt by simp
moreover have "?xn = y" using aa asmt by simp
ultimately have "both_member_options (Node (Some (mi, ma)) deg treeList summary) y" by simp
then show ?thesis using bb
using ‹summin * 2 ^ n + lx = y› ‹y = ?xn ⟹ x ≠ y ∧ both_member_options (Node (Some (mi, ma)) deg treeList summary) y› by blast
next
case False
then obtain maxs where "Some maxs = ?maxs" by force
hence "both_member_options ?sn maxs"
by (simp add: maxbmo)
hence "both_member_options summary maxs ∧ maxs ≠ ?h"
using "4.IH"(2) by blast
hence "?newlist ! the ?maxs = treeList ! maxs"
by (metis "4.hyps"(1) ‹Some maxs = vebt_maxt (vebt_delete summary (high (summin * 2 ^ n + lx) n))› option.sel member_bound nothprolist valid_member_both_member_options)
have "maxs < 2^m"
using "4.hyps"(1) ‹both_member_options summary maxs ∧ maxs ≠ high (summin * 2 ^ n + lx) n› member_bound valid_member_both_member_options by blast
hence "the (vebt_maxt (?newlist ! the ?maxs)) = the (vebt_maxt (treeList ! maxs))"
using ‹?newlist ! the (vebt_maxt ?sn) = treeList ! maxs› by presburger
have "∃ z. both_member_options(treeList ! maxs) z"
using "4.hyps"(5) ‹both_member_options summary maxs ∧ maxs ≠?h› ‹maxs < 2 ^ m› by blast
moreover have "invar_vebt (treeList ! maxs) n" using 4
by (metis ‹maxs < 2 ^ m› inthall member_def)
ultimately obtain maxi where "Some maxi = (vebt_maxt (treeList ! maxs))"
by (metis empty_Collect_eq maxt_corr_help_empty not_None_eq set_vebt'_def valid_member_both_member_options)
hence "maxi < 2^n"
by (metis ‹invar_vebt (treeList ! maxs) n› maxt_member member_bound)
hence "both_member_options (treeList ! maxs) maxi"
using ‹Some maxi = vebt_maxt (treeList ! maxs)› maxbmo by presburger
hence "2 ^ (deg div 2) * the ?maxs + the
(vebt_maxt (?newlist ! the ?maxs)) = 2^n * maxs + maxi "
by (metis ‹Some maxi = vebt_maxt (treeList ! maxs)› ‹Some maxs = vebt_maxt ?sn› ‹deg div 2 = n› ‹the (vebt_maxt (?newlist ! the (vebt_maxt ?sn))) = the (vebt_maxt (treeList ! maxs))› option.sel)
hence "?newma = 2^n * maxs + maxi"
using False True by auto
hence "y = 2^n * maxs + maxi" using asmt by simp
hence "both_member_options (Node (Some (mi, ma)) deg treeList summary) y"
by (metis "4.hyps"(2) Suc_1 ‹both_member_options (treeList ! maxs) maxi› ‹deg div 2 = n› ‹maxi < 2 ^ n› ‹maxs < 2 ^ m› add_leD1 both_member_options_from_chilf_to_complete_tree dp high_inv low_inv mult.commute plus_1_eq_Suc)
moreover hence "y ≠ x"
by (metis "4.hyps"(9) True ‹Some maxi = vebt_maxt (treeList ! maxs)› ‹maxi < 2 ^ n› ‹maxs < 2 ^ m› ‹x = mi› ‹y = 2 ^ n * maxs + maxi› high_inv less_not_refl low_inv maxbmo minxnrel mult.commute)
ultimately show ?thesis by force
qed
next
case False
hence "?newma = ma" by simp
moreover hence "mi ≠ ma"
using mimapr by blast
moreover hence "y ≠ x"
using False ‹y = ?newma› ‹x = mi› by auto
then show ?thesis
by (metis False ‹y =?newma› both_member_options_equiv_member vebt_maxt.simps(3) maxt_member tvalid)
qed
qed
moreover have "(both_member_options (?newlist ! (high y (deg div 2))) (low y (deg div 2)) ∧ (high y (deg div 2)) < length ?newlist) ⟹ ?thesis"
proof-
assume assm:"both_member_options (?newlist ! (high y (deg div 2))) (low y (deg div 2)) ∧ (high y (deg div 2)) < length ?newlist"
show ?thesis
proof(cases "(high y (deg div 2)) = ?h")
case True
hence 000:"both_member_options ?newnode (low y (deg div 2)) " using hprolist by (metis assm)
hence 001:"invar_vebt (treeList ! (high y (deg div 2))) n"
using True ‹vebt_member (treeList ! summin) lx› ‹invar_vebt (treeList ! summin) n› high_inv member_bound by presburger
then show ?thesis
proof(cases "low y n = ?l")
case True
hence "y = ?xn"
by (metis "000" "4.IH"(1) ‹deg div 2 = n› ‹high (summin * 2 ^ n + lx) n < length treeList› inthall member_def)
then show ?thesis
using calculation(2) by blast
next
case False
hence "both_member_options (treeList ! ?h) (low y (deg div 2)) ∧ (low y (deg div 2)) ≠ (low ?xn (deg div 2))"
using "4.IH"(1) ‹deg div 2 = n› ‹high ?xn n < length treeList› inthall member_def
by (metis "000")
then show ?thesis
by (metis "4.hyps"(2) "4.hyps"(9) Suc_1 Suc_leD True ‹deg div 2 = n› ‹length treeList = length ?newlist› ‹x = mi› assm both_member_options_from_chilf_to_complete_tree dp less_not_refl mimapr)
qed
next
case False
hence "x ≠ y"
by (metis "4.hyps"(2) "4.hyps"(9) ‹deg div 2 = n› ‹length treeList = length ?newlist› ‹x = mi› assm less_not_refl mimapr nothprolist)
moreover hence "(?newlist ! (high y (deg div 2))) = treeList ! (high y (deg div 2))" using nothprolist
using "4.hyps"(2) False ‹length treeList = length ?newlist› assm by presburger
moreover hence "both_member_options (treeList ! (high y (deg div 2)) ) (low y (deg div 2))"
using assm by presburger
moreover hence "both_member_options (Node (Some (mi, ma)) deg treeList summary) y"
by (metis One_nat_def Suc_leD ‹length treeList = length ?newlist› assm both_member_options_from_chilf_to_complete_tree dp numeral_2_eq_2)
ultimately show ?thesis by blast
qed
qed
ultimately show ?thesis by fastforce
qed
moreover have "(x ≠ y ∧ both_member_options (Node (Some (mi, ma)) deg treeList summary) y)⟹
both_member_options ?delsimp y"
proof-
assume assm: "x ≠ y ∧ both_member_options (Node (Some (mi, ma)) deg treeList summary) y"
hence abcv:"y = mi ∨ y = ma ∨ ( high y n < length treeList ∧ both_member_options (treeList ! (high y n)) (low y n))"
by (metis Suc_1 ‹deg div 2 = n› add_leD1 both_member_options_from_complete_tree_to_child member_inv plus_1_eq_Suc tvalid valid_member_both_member_options)
thus " both_member_options ?delsimp y"
proof-
have "y = mi ⟹ ?thesis"
using False assm by force
moreover have " y = ma ⟹ ?thesis"
by (smt (z3) Suc_le_D both_member_options_def dp membermima.simps(4) nat_1_add_1 plus_1_eq_Suc)
moreover have " both_member_options (treeList ! (high y n)) (low y n) ⟹ ?thesis"
proof-
assume myass: "both_member_options (treeList ! (high y n)) (low y n) "
thus ?thesis
proof(cases "high y n = ?h")
case True
hence "high y n = ?h" by simp
then show ?thesis
proof(cases "low y n = ?l")
case True
hence "y = ?xn"
by (metis ‹high y n = high (summin * 2 ^ n + lx) n› bit_split_inv)
then show ?thesis
by (metis Suc_le_D both_member_options_def dp membermima.simps(4) nat_1_add_1 plus_1_eq_Suc)
next
case False
hence "low y n ≠ ?l"
by (metis assm bit_split_inv)
hence pp:"?newlist ! ?h = ?newnode"
using hprolist by blast
hence "invar_vebt (treeList ! ?h) n"
using ‹vebt_member (treeList ! summin) lx› ‹invar_vebt (treeList ! summin) n› high_inv member_bound by presburger
hence "both_member_options ?newnode (low y n)"
using "4.IH"(1) False True ‹high (summin * 2 ^ n + lx) n < length treeList› myass by auto
then show ?thesis
by (metis True ‹deg div 2 = n› ‹high (summin * 2 ^ n + lx) n < length treeList› ‹length treeList = length ?newlist› add_leD1 both_member_options_from_chilf_to_complete_tree dp nat_1_add_1 pp)
qed
next
case False
hence pp:"?newlist ! (high y n) = treeList ! (high y n)" using nothprolist abcv
by (metis "4.hyps"(1) "4.hyps"(3) "4.hyps"(4) assm deg_not_0 exp_split_high_low(1) member_bound tvalid valid_member_both_member_options)
then show ?thesis
by (metis One_nat_def Suc_leD ‹deg div 2 = n› ‹length treeList = length ?newlist› abcv both_member_options_from_chilf_to_complete_tree calculation(1) calculation(2) dp numerals(2))
qed
qed
then show ?thesis
using abcv calculation(1) calculation(2) by fastforce
qed
qed
ultimately show ?thesis by metis
next
case False
hence notemp:"∃ z. both_member_options ?newnode z"
using not_min_Null_member by auto
let ?newma = "(if ?xn = ma then
?h * 2^(deg div 2) + the( vebt_maxt (?newlist ! ?h))
else ma)"
let ?delsimp =" (Node (Some (?xn, ?newma)) deg ?newlist summary)"
have "vebt_delete (Node (Some (mi, ma)) deg treeList summary) x = ?delsimp"
using del_x_mi_lets_in_not_minNull[of x mi ma deg ?xn ?h summary treeList ?l ?newnode ?newlist]
by (metis "4.hyps"(3) "4.hyps"(4) False ‹Some lx = vebt_mint (treeList ! summin)› ‹Some summin = vebt_mint summary› ‹high (summin * 2 ^ n + lx) n < length treeList› ‹x = mi› add_self_div_2 dp option.sel less_not_refl mimapr)
moreover have "both_member_options ?delsimp y
⟹ x ≠ y ∧ both_member_options (Node (Some (mi, ma)) deg treeList summary) y"
proof-
assume ssms: "both_member_options ?delsimp y "
hence aaaa: "y = ?xn ∨ y = ?newma ∨ (both_member_options (?newlist ! (high y n)) (low y n) ∧ high y n < length ?newlist)"
by (smt (z3) Suc_1 Suc_le_D ‹deg div 2 = n› both_member_options_def dp membermima.simps(4) naive_member.simps(3))
show " x ≠ y ∧ both_member_options (Node (Some (mi, ma)) deg treeList summary) y"
proof-
have "y = ?xn ⟹?thesis"
using ‹x = mi› minxnrel xnin by blast
moreover have " y = ?newma ⟹ ?thesis"
proof-
assume "y = ?newma"
show ?thesis
proof(cases "?xn = ma")
case True
hence aaa:"?newma =?h * 2 ^ (deg div 2) +the(vebt_maxt(?newlist ! ?h))"
by metis
have "?newlist ! ?h = ?newnode" using hprolist by blast
obtain maxi where maxidef:"Some maxi = vebt_maxt(?newlist ! ?h)"
by (metis False hprolist vebt_maxt.elims minNull.simps(1) minNull.simps(4))
have aa:"invar_vebt (treeList ! ?h) n"
by (metis "4.IH"(1) ‹high ?xn n < length treeList› inthall member_def)
moreover hence ab:"maxi ≠ ?l ∧ both_member_options ?newnode maxi"
by (metis "4.IH"(1) ‹high ?xn n < length treeList› hprolist inthall maxbmo maxidef member_def)
ultimately have ac:"maxi ≠ ?l ∧ both_member_options (treeList ! ?h) maxi"
by (metis "4.IH"(1) ‹high ?xn n < length treeList› inthall member_def)
hence ad:"maxi < 2^n"
by (meson aa member_bound valid_member_both_member_options)
then show ?thesis using Suc_1 aaa ‹y = ?newma› ac add_leD1
by (metis "4.hyps"(2) "4.hyps"(9) Suc_leD ‹deg div 2 = n› ‹high (summin * 2 ^ n + lx) n < length treeList› ‹x = mi› both_member_options_from_chilf_to_complete_tree dp option.sel high_inv less_not_refl low_inv maxidef mimapr)
next
case False
then show ?thesis
by (metis ‹mi ≤ x ∧ x ≤ ma› ‹x = mi› ‹y = ?newma› both_member_options_equiv_member leD vebt_maxt.simps(3) maxt_member mimapr tvalid)
qed
qed
moreover have "(both_member_options (?newlist ! (high y n)) (low y n)∧ high y n < length ?newlist) ⟹ ?thesis"
proof-
assume assmy:"(both_member_options (?newlist ! (high y n)) (low y n)∧ high y n < length ?newlist)"
then show ?thesis
proof(cases "high y n = ?h")
case True
hence "?newlist ! (high y n) = ?newnode"
using hprolist by presburger
have "invar_vebt (treeList ! ?h) n"
by (metis "4.IH"(1) ‹high ?xn n < length treeList› inthall member_def)
then show ?thesis
proof(cases "low y n= ?l")
case True
hence "y = ?xn"
using "4.IH"(1) ‹high (summin * 2 ^ n + lx) n < length treeList› ‹treeList [high (summin * 2 ^ n + lx) n := vebt_delete (treeList ! high (summin * 2 ^ n + lx) n) (low (summin * 2 ^ n + lx) n)] ! high y n = vebt_delete (treeList ! high (summin * 2 ^ n + lx) n) (low (summin * 2 ^ n + lx) n)› assmy by force
then show ?thesis
using calculation(1) by blast
next
case False
hence "low y n ≠ ?l ∧ both_member_options (treeList ! ?h ) (low y n)" using assmy
by (metis "4.IH"(1) "4.hyps"(2) ‹?newlist ! high y n = vebt_delete (treeList ! high (summin * 2 ^ n + lx) n) (low (summin * 2 ^ n + lx) n)› ‹vebt_member (treeList ! summin) lx› ‹summin < 2 ^ m› high_inv inthall member_bound member_def)
then show ?thesis
by (metis "4.hyps"(2) "4.hyps"(9) Suc_1 Suc_leD True ‹deg div 2 = n› ‹high (summin * 2 ^ n + lx) n < length treeList› ‹mi ≤ x ∧ x ≤ ma› ‹x = mi› both_member_options_from_chilf_to_complete_tree dp leD mimapr)
qed
next
case False
hence "?newlist ! (high y n) = treeList !(high y n)"
by (smt (z3) "4.hyps"(1) "4.hyps"(2) "4.hyps"(3) "4.hyps"(4) "4.hyps"(8) ‹length treeList = length ?newlist› ‹ma ≤ 2 ^ deg› aaaa calculation(2) deg_not_0 exp_split_high_low(1) less_le_trans member_inv mimapr nothprolist tvalid valid_member_both_member_options)
hence "both_member_options (treeList !(high y n)) (low y n)"
using assmy by presburger
moreover have "x ≠ y"
by (metis "4.hyps"(1) "4.hyps"(4) "4.hyps"(9) ‹invar_vebt (treeList ! summin) n› ‹x < 2 ^ deg› ‹x = mi› calculation deg_not_0 exp_split_high_low(1) mimapr not_less_iff_gr_or_eq)
moreover have "high y n < length ?newlist" using assmy by blast
moreover hence "high y n < length treeList"
using ‹length treeList = length ?newlist› by presburger
ultimately show ?thesis
by (metis One_nat_def Suc_leD ‹deg div 2 = n› both_member_options_from_chilf_to_complete_tree dp numerals(2))
qed
qed
ultimately show ?thesis
using aaaa by fastforce
qed
qed
moreover have "(x ≠ y ∧ both_member_options (Node (Some (mi, ma)) deg treeList summary) y)⟹
both_member_options ?delsimp y"
proof-
assume assm: "x ≠ y ∧ both_member_options (Node (Some (mi, ma)) deg treeList summary) y"
hence abcv:"y = mi ∨ y = ma ∨ ( high y n < length treeList ∧ both_member_options (treeList ! (high y n)) (low y n))"
by (metis Suc_1 ‹deg div 2 = n› add_leD1 both_member_options_from_complete_tree_to_child member_inv plus_1_eq_Suc tvalid valid_member_both_member_options)
thus " both_member_options ?delsimp y"
proof-
have "y = mi ⟹ ?thesis"
using ‹x = mi› assm by blast
moreover have " y = ma ⟹ ?thesis"
by (smt (z3) Suc_1 Suc_le_D both_member_options_def dp membermima.simps(4))
moreover have " ( high y n < length treeList ∧ both_member_options (treeList ! (high y n)) (low y n))
⟹ ?thesis"
proof-
assume myass: "( high y n < length treeList ∧ both_member_options (treeList ! (high y n)) (low y n)) "
thus ?thesis
proof(cases "high y n = ?h")
case True
then show ?thesis
proof(cases "low y n = ?l")
case True
then show ?thesis
by (smt (z3) Suc_1 Suc_le_D ‹deg div 2 = n› ‹length treeList = length (treeList [high (summin * 2 ^ n + lx) n := vebt_delete (treeList ! high (summin * 2 ^ n + lx) n) (low (summin * 2 ^ n + lx) n)])› add_leD1 bit_split_inv both_member_options_def both_member_options_from_chilf_to_complete_tree dp membermima.simps(4) myass nth_list_update_neq plus_1_eq_Suc)
next
case False
hence "low y n ≠ ?l" by simp
hence pp:"?newlist ! ?h = ?newnode"
using hprolist by blast
hence "invar_vebt (treeList ! ?h) n"
by (metis "4.IH"(1) ‹high ?xn n < length treeList› inthall member_def)
hence "both_member_options ?newnode (low y n)"
by (metis "4.IH"(1) True ‹high ?xn n < length treeList› ‹low y n ≠ low ?xn n› in_set_member inthall myass)
then show ?thesis
by (metis One_nat_def Suc_leD True ‹deg div 2 = n› ‹high (summin * 2 ^ n + lx) n < length treeList› ‹length treeList = length ?newlist› both_member_options_from_chilf_to_complete_tree dp numerals(2) pp)
qed
next
case False
have pp:"?newlist ! (high y n) = treeList ! (high y n)"
using nothprolist[of "high y n"] False
by (metis "4.hyps"(1) "4.hyps"(3) "4.hyps"(4) assm deg_not_0 exp_split_high_low(1) member_bound tvalid valid_member_both_member_options)
then show ?thesis
by (metis One_nat_def Suc_leD ‹deg div 2 = n› ‹length treeList = length ?newlist› abcv both_member_options_from_chilf_to_complete_tree calculation(1) calculation(2) dp numerals(2))
qed
qed
then show ?thesis
using abcv calculation(1) calculation(2) by fastforce
qed
qed
ultimately show ?thesis by metis
qed
qed
qed
qed
next
case (5 treeList n summary m deg mi ma)
hence tvalid: "invar_vebt (Node (Some (mi, ma)) deg treeList summary) deg"
using invar_vebt.intros(5)[of treeList n summary m deg mi ma] by simp
hence "mi ≤ ma" and "deg div 2 = n" and "ma ≤ 2^deg" using 5
by (auto simp add: "5.hyps"(3) "5.hyps"(4))
hence dp:"deg ≥ 2"
by (meson vebt_maxt.simps(3) maxt_member member_inv tvalid)
hence nmpr:"n≥ 1 ∧ m = Suc n"
using "5.hyps"(3) ‹deg div 2 = n› by linarith
then show ?case proof(cases "x <mi ∨ x > ma")
case True
hence "vebt_delete (Node (Some (mi, ma)) deg treeList summary) x = (Node (Some (mi, ma)) deg treeList summary)"
using delt_out_of_range[of x mi ma deg treeList summary] ‹2 ≤ deg› by blast
then show ?thesis
by (metis "5.hyps"(7) True tvalid leD member_inv not_less_iff_gr_or_eq valid_member_both_member_options)
next
case False
hence "mi ≤ x ∧ x ≤ ma" by simp
hence xdegrel:"x < 2^deg"
using "5.hyps"(8) order.strict_trans1 by blast
then show ?thesis
proof(cases "x = mi ∧ x = ma")
case True
hence "vebt_delete (Node (Some (mi, ma)) deg treeList summary) x = (Node None deg treeList summary)"
using del_single_cont[of x mi ma deg treeList summary] ‹2 ≤ deg› by blast
moreover hence "invar_vebt (Node None deg treeList summary) deg"
using "5"(4) "5.IH"(1) "5.hyps"(1) "5.hyps"(3) "5.hyps"(4) True mi_eq_ma_no_ch
tvalid invar_vebt.intros(3) by force
moreover hence "¬ vebt_member (Node None deg treeList summary) y" by simp
moreover hence "¬both_member_options (Node None deg treeList summary) y"
using calculation(2) valid_member_both_member_options by blast
then show ?thesis
by (metis True calculation(1) member_inv not_less_iff_gr_or_eq tvalid valid_member_both_member_options)
next
case False
hence mimapr:"mi < ma"
by (metis "5.hyps"(7) ‹mi ≤ x ∧ x ≤ ma› le_antisym nat_less_le)
then show ?thesis
proof(cases "x ≠ mi")
case True
hence xmi:"x ≠ mi" by simp
let ?h ="high x n"
let ?l = "low x n"
have "?h < length treeList" using xdegrel 5
by (metis ‹deg div 2 = n› deg_not_0 div_greater_zero_iff dp exp_split_high_low(1) zero_less_numeral)
let ?newnode = "vebt_delete (treeList ! ?h) ?l"
let ?newlist = "treeList[?h:=?newnode]"
have "length treeList = length ?newlist" by simp
hence hprolist: "?newlist ! ?h = ?newnode"
by (meson ‹high x n < length treeList› nth_list_update_eq)
have nothprolist: "i ≠ ?h ∧ i < 2^m ⟹ ?newlist ! i = treeList ! i" for i by simp
then show ?thesis
proof(cases "minNull ?newnode")
case True
let ?sn = "vebt_delete summary ?h"
let ?newma= "(if x = ma then (let maxs = vebt_maxt ?sn in
(if maxs = None
then mi
else 2^(deg div 2) * the maxs
+ the (vebt_maxt (?newlist ! the maxs))
)
)
else ma)"
let ?delsimp =" (Node (Some (mi, ?newma)) deg ?newlist ?sn)"
have "vebt_delete (Node (Some (mi, ma)) deg treeList summary) x = ?delsimp"
using del_x_not_mi_new_node_nil[of mi x ma deg ?h ?l ?newnode treeList ?sn summary ?newlist]
by (metis True ‹2 ≤ deg› ‹deg div 2 = n› ‹high x n < length treeList› ‹mi < ma› ‹mi ≤ x ∧ x ≤ ma› ‹x ≠ mi› less_not_refl3 order.not_eq_order_implies_strict)
moreover have "both_member_options (?delsimp) y ⟹ (x ≠ y ∧ both_member_options (Node (Some (mi, ma)) deg treeList summary) y)"
proof-
assume "both_member_options (?delsimp) y"
hence "y = mi ∨ y = ?newma ∨
(both_member_options (?newlist ! (high y (deg div 2))) (low y (deg div 2)) ∧ (high y (deg div 2)) < length ?newlist)"
using both_member_options_from_complete_tree_to_child[of deg mi ?newma ?newlist ?sn y] dp
by (smt (z3) Suc_1 Suc_le_D both_member_options_def membermima.simps(4) naive_member.simps(3))
moreover have "y = mi ⟹ ?thesis"
by (meson ‹x ≠ mi› both_member_options_equiv_member vebt_mint.simps(3) mint_member tvalid)
moreover have "y = ?newma ⟹ ?thesis"
proof-
assume "y = ?newma"
show ?thesis
proof(cases "x = ma")
case True
let ?maxs = "vebt_maxt ?sn"
have newmapropy:"?newma = (if ?maxs = None then mi
else 2 ^ (deg div 2) * the ?maxs + the (vebt_maxt
(?newlist !
the ?maxs)))" using True by force
then show ?thesis
proof(cases "?maxs = None ")
case True
then show ?thesis
using ‹y = (if x = ma then let maxs = vebt_maxt (vebt_delete summary (high x n)) in if maxs = None then mi else 2 ^ (deg div 2) * the maxs + the (vebt_maxt (treeList [high x n := vebt_delete (treeList ! high x n) (low x n)] ! the maxs)) else ma)› calculation(2) newmapropy by presburger
next
case False
then obtain maxs where "Some maxs = ?maxs" by force
hence "both_member_options ?sn maxs"
by (simp add: maxbmo)
hence "both_member_options summary maxs ∧ maxs ≠ ?h"
using "5.IH"(2) by blast
hence "?newlist ! the ?maxs = treeList ! maxs"
by (metis "5.hyps"(1) ‹Some maxs = vebt_maxt (vebt_delete summary (high x n))› option.sel member_bound nothprolist valid_member_both_member_options)
have "maxs < 2^m"
using "5.hyps"(1) ‹both_member_options summary maxs ∧ maxs ≠ high x n› member_bound valid_member_both_member_options by blast
hence "the (vebt_maxt (?newlist ! the ?maxs)) = the (vebt_maxt (treeList ! maxs))"
by (metis ‹Some maxs = vebt_maxt (vebt_delete summary (high x n))› ‹both_member_options summary maxs ∧ maxs ≠ high x n› option.sel nth_list_update_neq)
have "∃ z. both_member_options(treeList ! maxs) z"
by (simp add: "5.hyps"(5) ‹both_member_options summary maxs ∧ maxs ≠ high x n› ‹maxs < 2 ^ m›)
moreover have "invar_vebt (treeList ! maxs) n" using 5
by (metis ‹maxs < 2 ^ m› inthall member_def)
ultimately obtain maxi where "Some maxi = (vebt_maxt (treeList ! maxs))"
by (metis empty_Collect_eq maxt_corr_help_empty not_None_eq set_vebt'_def valid_member_both_member_options)
hence "maxi < 2^n"
by (metis ‹invar_vebt (treeList ! maxs) n› maxt_member member_bound)
hence "both_member_options (treeList ! maxs) maxi"
using ‹Some maxi = vebt_maxt (treeList ! maxs)› maxbmo by presburger
hence "2 ^ (deg div 2) * the ?maxs + the
(vebt_maxt (?newlist ! the ?maxs)) = 2^n * maxs + maxi "
by (metis ‹Some maxi = vebt_maxt (treeList ! maxs)› ‹Some maxs = vebt_maxt (vebt_delete summary (high x n))› ‹deg div 2 = n› ‹the (vebt_maxt (treeList[high x n := vebt_delete (treeList ! high x n) (low x n)] ! the (vebt_maxt (vebt_delete summary (high x n))))) = the (vebt_maxt (treeList ! maxs))› option.sel)
hence "y = 2^n * maxs + maxi"
using False ‹y = (if x = ma then let maxs = vebt_maxt (vebt_delete summary (high x n)) in if maxs = None then mi else 2 ^ (deg div 2) * the maxs + the (vebt_maxt (treeList [high x n := vebt_delete (treeList ! high x n) (low x n)] ! the maxs)) else ma)› newmapropy by presburger
hence "both_member_options (Node (Some (mi, ma)) deg treeList summary) y"
by (metis "5.hyps"(2) Suc_1 ‹both_member_options (treeList ! maxs) maxi› ‹deg div 2 = n› ‹maxi < 2 ^ n› ‹maxs < 2 ^ m› add_leD1 both_member_options_from_chilf_to_complete_tree dp high_inv low_inv mult.commute plus_1_eq_Suc)
moreover hence "y ≠ x"
by (metis ‹both_member_options summary maxs ∧ maxs ≠ high x n› ‹maxi < 2 ^ n› ‹y = 2 ^ n * maxs + maxi› high_inv mult.commute)
ultimately show ?thesis by force
qed
next
case False
hence "?newma = ma" by simp
moreover hence "y ≠ x"
using False ‹y = ?newma› by presburger
then show ?thesis
by (metis False ‹y =?newma› both_member_options_equiv_member vebt_maxt.simps(3) maxt_member tvalid)
qed
qed
moreover have "(both_member_options (?newlist ! (high y (deg div 2))) (low y (deg div 2)) ∧ (high y (deg div 2)) < length ?newlist) ⟹ ?thesis"
proof-
assume assm:"both_member_options (?newlist ! (high y (deg div 2))) (low y (deg div 2)) ∧ (high y (deg div 2)) < length ?newlist"
show ?thesis
proof(cases "(high y (deg div 2)) = ?h")
case True
hence "both_member_options ?newnode (low y (deg div 2)) " using hprolist by (metis assm)
moreover hence "invar_vebt (treeList ! (high y (deg div 2))) n"
by (metis "5.IH"(1) True ‹high x n < length treeList› inthall member_def)
ultimately have "both_member_options (treeList ! ?h) (low y (deg div 2)) ∧ (low y (deg div 2)) ≠ (low x (deg div 2))"
by (metis "5.IH"(1) ‹deg div 2 = n› ‹high x n < length treeList› inthall member_def)
then show ?thesis
by (metis Suc_1 True ‹high x n < length treeList› add_leD1 both_member_options_from_chilf_to_complete_tree dp plus_1_eq_Suc)
next
case False
hence "x ≠ y"
using ‹deg div 2 = n› by blast
moreover hence "(?newlist ! (high y (deg div 2))) = treeList ! (high y (deg div 2))" using nothprolist
using "5.hyps"(2) False ‹length treeList = length ?newlist› assm by presburger
moreover hence "both_member_options (treeList ! (high y (deg div 2)) ) (low y (deg div 2))"
using assm by presburger
moreover hence "both_member_options (Node (Some (mi, ma)) deg treeList summary) y"
by (metis One_nat_def Suc_leD ‹length treeList = length ?newlist› assm both_member_options_from_chilf_to_complete_tree dp numeral_2_eq_2)
ultimately show ?thesis by blast
qed
qed
ultimately show ?thesis by fastforce
qed
moreover have " (x ≠ y ∧ both_member_options (Node (Some (mi, ma)) deg treeList summary) y) ⟹ both_member_options (?delsimp) y"
proof-
assume "(x ≠ y ∧ both_member_options (Node (Some (mi, ma)) deg treeList summary) y)"
hence aa:"x ≠ y" and bb:"y = mi ∨ y = ma ∨ (both_member_options (treeList ! (high y n)) (low y n) ∧ high y n < length treeList)"
apply auto[1] by (metis Suc_1 ‹deg div 2 = n› ‹x ≠ y ∧ both_member_options (Node (Some (mi, ma)) deg treeList summary) y› add_leD1 both_member_options_from_complete_tree_to_child member_inv plus_1_eq_Suc tvalid valid_member_both_member_options)
show "both_member_options (?delsimp) y"
proof-
have "y = mi ⟹both_member_options (?delsimp) y"
by (metis Suc_1 Suc_le_D both_member_options_def dp membermima.simps(4))
moreover have "y = ma ⟹ both_member_options (?delsimp) y"
using aa maxbmo vebt_maxt.simps(3) by presburger
moreover have "both_member_options (treeList ! (high y n)) (low y n) ⟹both_member_options (?delsimp) y "
proof-
assume assmy: "both_member_options (treeList ! (high y n)) (low y n)"
then show "both_member_options (?delsimp) y "
proof(cases "high y n = ?h")
case True
moreover hence "?newlist ! (high y n) = ?newnode"
using hprolist by auto
hence 0:"invar_vebt (treeList !(high y n)) n" using 5
by (metis True ‹high x n < length treeList› inthall member_def)
moreover have 1:"low y n ≠ low x n"
by (metis True aa bit_split_inv)
moreover have 11:" (treeList !(high y n)) ∈ set treeList"
by (metis True ‹high x n < length treeList› inthall member_def)
ultimately have " (∀ xa. both_member_options ?newnode xa =
((low x n) ≠ xa ∧ both_member_options (treeList ! ?h) xa))"
by (simp add: "5.IH"(1))
hence "((low x n) ≠ xa ∧ both_member_options (treeList ! ?h) xa) ⟹ both_member_options ?newnode xa" for xa by blast
moreover have "((low x n) ≠ (low y n) ∧ both_member_options (treeList ! ?h) (low y n))" using 1
using True assmy by presburger
ultimately have "both_member_options ?newnode (low y n)" by blast
then show ?thesis
by (metis One_nat_def Suc_leD True ‹deg div 2 = n› ‹high x n < length treeList› ‹length treeList = length ?newlist› both_member_options_from_chilf_to_complete_tree dp hprolist numerals(2))
next
case False
hence "?newlist ! (high y n) = treeList ! (high y n)" by auto
hence "both_member_options (?newlist !(high y n)) (low y n)"
using assmy by presburger
then show ?thesis
by (smt (z3) Suc_1 Suc_le_D ‹deg div 2 = n› ‹length treeList = length ?newlist› aa add_leD1 bb both_member_options_def both_member_options_from_chilf_to_complete_tree dp membermima.simps(4) plus_1_eq_Suc)
qed
qed
ultimately show ?thesis using bb by fastforce
qed
qed
ultimately show ?thesis by metis
next
case False
hence notemp:"∃ z. both_member_options ?newnode z"
using not_min_Null_member by auto
let ?newma = "(if x = ma then
?h * 2^(deg div 2) + the( vebt_maxt (?newlist ! ?h))
else ma)"
let ?delsimp =" (Node (Some (mi, ?newma)) deg ?newlist summary)"
have "vebt_delete (Node (Some (mi, ma)) deg treeList summary) x = ?delsimp"
using del_x_not_mi_newnode_not_nil[of mi x ma deg ?h ?l ?newnode treeList ?newlist summary] False xmi mimapr
using ‹deg div 2 = n› ‹high x n < length treeList› ‹mi ≤ x ∧ x ≤ ma› dp nat_less_le plus_1_eq_Suc by fastforce
moreover have "both_member_options ?delsimp y
⟹ x ≠ y ∧ both_member_options (Node (Some (mi, ma)) deg treeList summary) y"
proof-
assume ssms: "both_member_options ?delsimp y "
hence aaaa: "y = mi ∨ y = ?newma ∨ (both_member_options (?newlist ! (high y n)) (low y n) ∧ high y n < length ?newlist)"
by (smt (z3) Suc_1 Suc_le_D ‹deg div 2 = n› both_member_options_def dp membermima.simps(4) naive_member.simps(3))
show " x ≠ y ∧ both_member_options (Node (Some (mi, ma)) deg treeList summary) y"
proof-
have "y = mi ⟹?thesis"
by (metis Suc_1 Suc_le_D both_member_options_def dp membermima.simps(4) xmi)
moreover have " y = ?newma ⟹ ?thesis"
proof-
assume "y = ?newma"
show ?thesis
proof(cases "x = ma")
case True
hence "?newma =?h * 2 ^ (deg div 2) +the(vebt_maxt(?newlist ! ?h))"
by metis
have "?newlist ! ?h = ?newnode" using hprolist by blast
obtain maxi where maxidef:"Some maxi = vebt_maxt(?newlist ! ?h)"
by (metis False hprolist vebt_maxt.elims minNull.simps(1) minNull.simps(4))
have aa:"invar_vebt (treeList ! ?h) n"
by (metis "5.IH"(1) ‹high x n < length treeList› inthall member_def)
moreover hence ab:"maxi ≠ ?l ∧ both_member_options ?newnode maxi"
by (metis "5.IH"(1) ‹high x n < length treeList› hprolist inthall maxbmo maxidef member_def)
ultimately have ac:"maxi ≠ ?l ∧ both_member_options (treeList ! ?h) maxi"
by (metis "5.IH"(1) ‹high x n < length treeList› inthall member_def)
hence ad:"maxi < 2^n"
using ‹invar_vebt (treeList ! high x n) n› member_bound valid_member_both_member_options by blast
then show ?thesis
by (metis Suc_1 ‹(if x = ma then high x n * 2 ^ (deg div 2) + the (vebt_maxt (treeList[high x n := vebt_delete (treeList ! high x n) (low x n)] ! high x n)) else ma) = high x n * 2 ^ (deg div 2) + the (vebt_maxt (treeList[high x n := vebt_delete (treeList ! high x n) (low x n)] ! high x n))› ‹deg div 2 = n› ‹high x n < length treeList› ‹y = (if x = ma then high x n * 2 ^ (deg div 2) + the (vebt_maxt (treeList[high x n := vebt_delete (treeList ! high x n) (low x n)] ! high x n)) else ma)› ac add_leD1 both_member_options_from_chilf_to_complete_tree dp option.sel high_inv low_inv maxidef plus_1_eq_Suc)
next
case False
then show ?thesis
by (simp add: ‹y = ?newma› maxbmo)
qed
qed
moreover have "both_member_options (?newlist ! (high y n)) (low y n) ⟹ ?thesis"
proof-
assume assmy:"both_member_options (?newlist ! (high y n)) (low y n)"
then show ?thesis
proof(cases "high y n = ?h")
case True
hence "?newlist ! (high y n) = ?newnode"
using hprolist by presburger
have "invar_vebt (treeList ! ?h) n"
by (metis "5.IH"(1) ‹high x n < length treeList› inthall member_def)
hence "low y n ≠ ?l ∧ both_member_options (treeList ! ?h ) (low y n)"
by (metis "5.IH"(1) True ‹high x n < length treeList› assmy hprolist inthall member_def)
then show ?thesis
by (metis Suc_1 True ‹deg div 2 = n› ‹high x n < length treeList› add_leD1 both_member_options_from_chilf_to_complete_tree dp plus_1_eq_Suc)
next
case False
hence "?newlist ! (high y n) = treeList !(high y n)" by auto
then show ?thesis
by (metis False Suc_1 ‹deg div 2 = n› ‹length treeList = length ?newlist› aaaa add_leD1 both_member_options_from_chilf_to_complete_tree calculation(1) calculation(2) dp plus_1_eq_Suc)
qed
qed
ultimately show ?thesis
using aaaa by fastforce
qed
qed
moreover have "(x ≠ y ∧ both_member_options (Node (Some (mi, ma)) deg treeList summary) y)⟹
both_member_options ?delsimp y"
proof-
assume assm: "x ≠ y ∧ both_member_options (Node (Some (mi, ma)) deg treeList summary) y"
hence abcv:"y = mi ∨ y = ma ∨ ( high y n < length treeList ∧ both_member_options (treeList ! (high y n)) (low y n))"
by (metis Suc_1 ‹deg div 2 = n› add_leD1 both_member_options_from_complete_tree_to_child member_inv plus_1_eq_Suc tvalid valid_member_both_member_options)
thus " both_member_options ?delsimp y"
proof-
have "y = mi ⟹ ?thesis"
by (metis Suc_1 Suc_le_D both_member_options_def dp membermima.simps(4))
moreover have " y = ma ⟹ ?thesis"
using assm maxbmo vebt_maxt.simps(3) by presburger
moreover have " both_member_options (treeList ! (high y n)) (low y n) ⟹ ?thesis"
proof-
assume myass: "both_member_options (treeList ! (high y n)) (low y n) "
thus ?thesis
proof(cases "high y n = ?h")
case True
hence "low y n ≠ ?l"
by (metis assm bit_split_inv)
hence pp:"?newlist ! ?h = ?newnode"
using hprolist by blast
hence "invar_vebt (treeList ! ?h) n"
by (metis "5.IH"(1) ‹high x n < length treeList› inthall member_def)
hence "both_member_options ?newnode (low y n)"
by (metis "5.IH"(1) True ‹high x n < length treeList› ‹low y n ≠ low x n› in_set_member inthall myass)
then show ?thesis
by (metis One_nat_def Suc_leD True ‹deg div 2 = n› ‹high x n < length treeList› ‹length treeList = length ?newlist› both_member_options_from_chilf_to_complete_tree dp numerals(2) pp)
next
case False
hence pp:"?newlist ! (high y n) = treeList ! (high y n)" using nothprolist abcv by auto
then show ?thesis
by (metis One_nat_def Suc_leD ‹deg div 2 = n› ‹length treeList = length ?newlist› abcv both_member_options_from_chilf_to_complete_tree calculation(1) calculation(2) dp numerals(2))
qed
qed
then show ?thesis
using abcv calculation(1) calculation(2) by fastforce
qed
qed
ultimately show ?thesis by metis
qed
next
case False
hence "x = mi" by simp
have "both_member_options summary (high ma n)"
by (metis "5"(10) "5"(11) "5"(7) "5.hyps"(4) Euclidean_Division.div_eq_0_iff Suc_leI Suc_le_D div_exp_eq dual_order.irrefl high_def mimapr nat.simps(3))
hence "vebt_member summary (high ma n)"
using "5.hyps"(1) valid_member_both_member_options by blast
obtain summin where "Some summin = vebt_mint summary"
by (metis "5.hyps"(1) ‹vebt_member summary (high ma n)› empty_Collect_eq mint_corr_help_empty not_None_eq set_vebt'_def)
hence "∃ z . both_member_options (treeList ! summin) z"
by (metis "5.hyps"(1) "5.hyps"(5) both_member_options_equiv_member member_bound mint_member)
moreover have "invar_vebt (treeList ! summin) n"
by (metis "5.IH"(1) "5.hyps"(1) "5.hyps"(2) ‹Some summin = vebt_mint summary› member_bound mint_member nth_mem)
ultimately obtain lx where "Some lx = vebt_mint (treeList ! summin)"
by (metis empty_Collect_eq mint_corr_help_empty not_None_eq set_vebt'_def valid_member_both_member_options)
let ?xn = "summin*2^n + lx"
have "?xn = (if x = mi
then the (vebt_mint summary) * 2^(deg div 2)
+ the (vebt_mint (treeList ! the (vebt_mint summary)))
else x)"
by (metis False ‹Some lx = vebt_mint (treeList ! summin)› ‹Some summin = vebt_mint summary› ‹deg div 2 = n› option.sel)
have "vebt_member (treeList ! summin) lx"
using ‹Some lx = vebt_mint (treeList ! summin)› ‹invar_vebt (treeList ! summin) n› mint_member by auto
moreover have "summin < 2^m"
by (metis "5.hyps"(1) ‹Some summin = vebt_mint summary› member_bound mint_member)
ultimately have xnin: "both_member_options (Node (Some (mi, ma)) deg treeList summary) ?xn"
by (metis "5.hyps"(2) Suc_1 ‹deg div 2 = n› ‹invar_vebt (treeList ! summin) n› add_leD1 both_member_options_equiv_member both_member_options_from_chilf_to_complete_tree dp high_inv low_inv member_bound plus_1_eq_Suc)
let ?h ="high ?xn n"
let ?l = "low ?xn n"
have "?xn < 2^deg"
by (smt (verit, ccfv_SIG) "5.hyps"(1) "5.hyps"(4) Euclidean_Division.div_eq_0_iff ‹Some lx = vebt_mint (treeList ! summin)› ‹Some summin = vebt_mint summary› ‹invar_vebt (treeList ! summin) n› div_exp_eq high_def high_inv le_0_eq member_bound mint_member not_numeral_le_zero power_not_zero)
hence "?h < length treeList"
using "5.hyps"(2) ‹vebt_member (treeList ! summin) lx› ‹summin < 2 ^ m› ‹invar_vebt (treeList ! summin) n› high_inv member_bound by presburger
let ?newnode = "vebt_delete (treeList ! ?h) ?l"
let ?newlist = "treeList[?h:= ?newnode]"
have "length treeList = length ?newlist" by simp
hence hprolist: "?newlist ! ?h = ?newnode"
by (meson ‹high (summin * 2 ^ n + lx) n < length treeList› nth_list_update)
have nothprolist: "i ≠ ?h ∧ i < 2^m ⟹ ?newlist ! i = treeList ! i" for i by simp
have firstsimp: "vebt_delete (Node (Some (mi, ma)) deg treeList summary) x =(
let newnode = vebt_delete (treeList ! ?h) ?l;
newlist = treeList[?h:= ?newnode] in
if minNull newnode
then(
let sn = vebt_delete summary ?h in
(Node (Some (?xn, if ?xn = ma then (let maxs = vebt_maxt sn in
(if maxs = None
then ?xn
else 2^(deg div 2) * the maxs
+ the (vebt_maxt (newlist ! the maxs))
)
)
else ma))
deg newlist sn)
)else
(Node (Some (?xn, (if ?xn = ma then
?h * 2^(deg div 2) + the( vebt_maxt (newlist ! ?h))
else ma)))
deg newlist summary ))"
using del_x_mi[of x mi ma deg ?xn ?h summary treeList ?l]
‹deg div 2 = n› ‹high (summin * 2 ^ n + lx) n < length treeList›
‹summin * 2 ^ n + lx = (if x = mi then the (vebt_mint summary) * 2 ^ (deg div 2) +
the (vebt_mint (treeList ! the (vebt_mint summary))) else x)› ‹x = mi› dp mimapr nat_less_le by smt
have minxnrel: "?xn ≠ mi"
by (metis "5.hyps"(2) "5.hyps"(9) ‹high (summin * 2 ^ n + lx) n < length treeList› ‹vebt_member (treeList ! summin) lx› ‹invar_vebt (treeList ! summin) n› both_member_options_equiv_member high_inv less_not_refl low_inv member_bound mimapr)
then show ?thesis
proof(cases "minNull ?newnode")
case True
let ?sn = "vebt_delete summary ?h"
let ?newma= "(if ?xn= ma then (let maxs = vebt_maxt ?sn in
(if maxs = None
then ?xn
else 2^(deg div 2) * the maxs
+ the (vebt_maxt (?newlist ! the maxs))
)
)
else ma)"
let ?delsimp =" (Node (Some (?xn, ?newma)) deg ?newlist ?sn)"
have "vebt_delete (Node (Some (mi, ma)) deg treeList summary) x = ?delsimp"
using del_x_mi_lets_in_minNull[of x mi ma deg ?xn ?h summary treeList ?l ?newnode ?newlist ?sn] False True ‹deg div 2 = n› ‹?h < length treeList› ‹summin * 2 ^ n + lx = (if x = mi then the (vebt_mint summary) * 2 ^ (deg div 2) + the (vebt_mint (treeList ! the (vebt_mint summary))) else x)› dp less_not_refl3 mimapr by fastforce
moreover have "both_member_options (?delsimp) y ⟹ (x ≠ y ∧ both_member_options (Node (Some (mi, ma)) deg treeList summary) y)"
proof-
assume "both_member_options (?delsimp) y"
hence "y = ?xn ∨ y = ?newma ∨
(both_member_options (?newlist ! (high y (deg div 2))) (low y (deg div 2)) ∧ (high y (deg div 2)) < length ?newlist)"
using both_member_options_from_complete_tree_to_child[of deg mi ?newma ?newlist ?sn y] dp
by (smt (z3) Suc_1 Suc_le_D both_member_options_def membermima.simps(4) naive_member.simps(3))
moreover have "y = ?xn ⟹ ?thesis"
by (metis "5.hyps"(9) False ‹vebt_member (treeList ! summin) lx› ‹summin < 2 ^ m› ‹invar_vebt (treeList ! summin) n› both_member_options_equiv_member high_inv less_not_refl low_inv member_bound mimapr xnin)
moreover have "y = ?newma ⟹ ?thesis"
proof-
assume asmt: "y = ?newma"
show ?thesis
proof(cases "?xn = ma")
case True
let ?maxs = "vebt_maxt ?sn"
have newmaext:"?newma = (if ?maxs = None then ?xn
else 2 ^ (deg div 2) * the ?maxs + the (vebt_maxt
( ?newlist ! the ?maxs)))" using True by force
then show ?thesis
proof(cases "?maxs = None ")
case True
hence aa:"?newma = ?xn" using newmaext by auto
hence bb: "?newma ≠ x"
using False minxnrel by presburger
hence "both_member_options (Node (Some (mi, ma)) deg treeList summary) ?xn"
using xnin newmaext minxnrel asmt by simp
moreover have "?xn = y" using aa asmt by simp
ultimately have "both_member_options (Node (Some (mi, ma)) deg treeList summary) y" by simp
then show ?thesis using bb
using ‹summin * 2 ^ n + lx = y› ‹y = ?xn ⟹ x ≠ y ∧ both_member_options (Node (Some (mi, ma)) deg treeList summary) y› by blast
next
case False
then obtain maxs where "Some maxs = ?maxs" by force
hence "both_member_options ?sn maxs"
by (simp add: maxbmo)
hence "both_member_options summary maxs ∧ maxs ≠ ?h"
using "5.IH"(2) by blast
hence "?newlist ! the ?maxs = treeList ! maxs"
by (metis "5.hyps"(1) ‹Some maxs = vebt_maxt (vebt_delete summary (high (summin * 2 ^ n + lx) n))› option.sel member_bound nothprolist valid_member_both_member_options)
have "maxs < 2^m"
using "5.hyps"(1) ‹both_member_options summary maxs ∧ maxs ≠ high (summin * 2 ^ n + lx) n› member_bound valid_member_both_member_options by blast
hence "the (vebt_maxt (?newlist ! the ?maxs)) = the (vebt_maxt (treeList ! maxs))"
using ‹?newlist ! the (vebt_maxt ?sn) = treeList ! maxs› by presburger
have "∃ z. both_member_options(treeList ! maxs) z"
using "5.hyps"(5) ‹both_member_options summary maxs ∧ maxs ≠?h› ‹maxs < 2 ^ m› by blast
moreover have "invar_vebt (treeList ! maxs) n" using 5
by (metis ‹maxs < 2 ^ m› inthall member_def)
ultimately obtain maxi where "Some maxi = (vebt_maxt (treeList ! maxs))"
by (metis empty_Collect_eq maxt_corr_help_empty not_None_eq set_vebt'_def valid_member_both_member_options)
hence "maxi < 2^n"
by (metis ‹invar_vebt (treeList ! maxs) n› maxt_member member_bound)
hence "both_member_options (treeList ! maxs) maxi"
using ‹Some maxi = vebt_maxt (treeList ! maxs)› maxbmo by presburger
hence "2 ^ (deg div 2) * the ?maxs + the
(vebt_maxt (?newlist ! the ?maxs)) = 2^n * maxs + maxi "
by (metis ‹Some maxi = vebt_maxt (treeList ! maxs)› ‹Some maxs = vebt_maxt ?sn› ‹deg div 2 = n› ‹the (vebt_maxt (?newlist ! the (vebt_maxt ?sn))) = the (vebt_maxt (treeList ! maxs))› option.sel)
hence "?newma = 2^n * maxs + maxi"
using False True by auto
hence "y = 2^n * maxs + maxi" using asmt by simp
hence "both_member_options (Node (Some (mi, ma)) deg treeList summary) y"
by (metis "5.hyps"(2) Suc_1 ‹both_member_options (treeList ! maxs) maxi› ‹deg div 2 = n› ‹maxi < 2 ^ n› ‹maxs < 2 ^ m› add_leD1 both_member_options_from_chilf_to_complete_tree dp high_inv low_inv mult.commute plus_1_eq_Suc)
moreover hence "y ≠ x"
by (metis "5.hyps"(9) True ‹Some maxi = vebt_maxt (treeList ! maxs)› ‹maxi < 2 ^ n› ‹maxs < 2 ^ m› ‹x = mi› ‹y = 2 ^ n * maxs + maxi› high_inv less_not_refl low_inv maxbmo minxnrel mult.commute)
ultimately show ?thesis by force
qed
next
case False
hence "?newma = ma" by simp
moreover hence "mi ≠ ma"
using mimapr by blast
moreover hence "y ≠ x"
using False ‹y = ?newma› ‹x = mi› by auto
then show ?thesis
by (metis False ‹y =?newma› both_member_options_equiv_member vebt_maxt.simps(3) maxt_member tvalid)
qed
qed
moreover have "(both_member_options (?newlist ! (high y (deg div 2))) (low y (deg div 2)) ∧ (high y (deg div 2)) < length ?newlist) ⟹ ?thesis"
proof-
assume assm:"both_member_options (?newlist ! (high y (deg div 2))) (low y (deg div 2)) ∧ (high y (deg div 2)) < length ?newlist"
show ?thesis
proof(cases "(high y (deg div 2)) = ?h")
case True
hence 000:"both_member_options ?newnode (low y (deg div 2)) " using hprolist by (metis assm)
hence 001:"invar_vebt (treeList ! (high y (deg div 2))) n"
using True ‹vebt_member (treeList ! summin) lx› ‹invar_vebt (treeList ! summin) n› high_inv member_bound by presburger
then show ?thesis
proof(cases "low y n = ?l")
case True
hence "y = ?xn"
by (metis "000" "5.IH"(1) ‹deg div 2 = n› ‹high (summin * 2 ^ n + lx) n < length treeList› inthall member_def)
then show ?thesis
using calculation(2) by blast
next
case False
hence "both_member_options (treeList ! ?h) (low y (deg div 2)) ∧ (low y (deg div 2)) ≠ (low ?xn (deg div 2))"
using "5.IH"(1) ‹deg div 2 = n› ‹high ?xn n < length treeList› inthall member_def
by (metis "000")
then show ?thesis
by (metis "5.hyps"(2) "5.hyps"(9) Suc_1 Suc_leD True ‹deg div 2 = n› ‹length treeList = length ?newlist› ‹x = mi› assm both_member_options_from_chilf_to_complete_tree dp less_not_refl mimapr)
qed
next
case False
hence "x ≠ y"
by (metis "5.hyps"(2) "5.hyps"(9) ‹deg div 2 = n› ‹length treeList = length ?newlist› ‹x = mi› assm less_not_refl mimapr nothprolist)
moreover hence "(?newlist ! (high y (deg div 2))) = treeList ! (high y (deg div 2))" using nothprolist
using "5.hyps"(2) False ‹length treeList = length ?newlist› assm by presburger
moreover hence "both_member_options (treeList ! (high y (deg div 2)) ) (low y (deg div 2))"
using assm by presburger
moreover hence "both_member_options (Node (Some (mi, ma)) deg treeList summary) y"
by (metis One_nat_def Suc_leD ‹length treeList = length ?newlist› assm both_member_options_from_chilf_to_complete_tree dp numeral_2_eq_2)
ultimately show ?thesis by blast
qed
qed
ultimately show ?thesis by fastforce
qed
moreover have "(x ≠ y ∧ both_member_options (Node (Some (mi, ma)) deg treeList summary) y)⟹
both_member_options ?delsimp y"
proof-
assume assm: "x ≠ y ∧ both_member_options (Node (Some (mi, ma)) deg treeList summary) y"
hence abcv:"y = mi ∨ y = ma ∨ ( high y n < length treeList ∧ both_member_options (treeList ! (high y n)) (low y n))"
by (metis Suc_1 ‹deg div 2 = n› add_leD1 both_member_options_from_complete_tree_to_child member_inv plus_1_eq_Suc tvalid valid_member_both_member_options)
thus " both_member_options ?delsimp y"
proof-
have "y = mi ⟹ ?thesis"
using False assm by force
moreover have " y = ma ⟹ ?thesis"
by (smt (z3) Suc_le_D both_member_options_def dp membermima.simps(4) nat_1_add_1 plus_1_eq_Suc)
moreover have " both_member_options (treeList ! (high y n)) (low y n) ⟹ ?thesis"
proof-
assume myass: "both_member_options (treeList ! (high y n)) (low y n) "
thus ?thesis
proof(cases "high y n = ?h")
case True
hence "high y n = ?h" by simp
then show ?thesis
proof(cases "low y n = ?l")
case True
hence "y = ?xn"
by (metis ‹high y n = high (summin * 2 ^ n + lx) n› bit_split_inv)
then show ?thesis
by (metis Suc_le_D both_member_options_def dp membermima.simps(4) nat_1_add_1 plus_1_eq_Suc)
next
case False
hence "low y n ≠ ?l"
by (metis assm bit_split_inv)
hence pp:"?newlist ! ?h = ?newnode"
using hprolist by blast
hence "invar_vebt (treeList ! ?h) n"
using ‹vebt_member (treeList ! summin) lx› ‹invar_vebt (treeList ! summin) n› high_inv member_bound by presburger
hence "both_member_options ?newnode (low y n)"
using "5.IH"(1) False True ‹high (summin * 2 ^ n + lx) n < length treeList› myass by force
then show ?thesis
by (metis True ‹deg div 2 = n› ‹high (summin * 2 ^ n + lx) n < length treeList› ‹length treeList = length ?newlist› add_leD1 both_member_options_from_chilf_to_complete_tree dp nat_1_add_1 pp)
qed
next
case False
hence pp:"?newlist ! (high y n) = treeList ! (high y n)" using nothprolist abcv by auto
then show ?thesis
by (metis One_nat_def Suc_leD ‹deg div 2 = n› ‹length treeList = length ?newlist› abcv both_member_options_from_chilf_to_complete_tree calculation(1) calculation(2) dp numerals(2))
qed
qed
then show ?thesis
using abcv calculation(1) calculation(2) by fastforce
qed
qed
ultimately show ?thesis by metis
next
case False
hence notemp:"∃ z. both_member_options ?newnode z"
using not_min_Null_member by auto
let ?newma = "(if ?xn = ma then
?h * 2^(deg div 2) + the( vebt_maxt (?newlist ! ?h))
else ma)"
let ?delsimp =" (Node (Some (?xn, ?newma)) deg ?newlist summary)"
have "vebt_delete (Node (Some (mi, ma)) deg treeList summary) x = ?delsimp"
using del_x_mi_lets_in_not_minNull[of x mi ma deg ?xn ?h summary treeList ?l ?newnode ?newlist]
using False ‹deg div 2 = n› ‹high (summin * 2 ^ n + lx) n < length treeList› ‹summin * 2 ^ n + lx = (if x = mi then the (vebt_mint summary) * 2 ^ (deg div 2) + the (vebt_mint (treeList ! the (vebt_mint summary))) else x)› ‹x = mi› dp mimapr nat_less_le by fastforce
moreover have "both_member_options ?delsimp y
⟹ x ≠ y ∧ both_member_options (Node (Some (mi, ma)) deg treeList summary) y"
proof-
assume ssms: "both_member_options ?delsimp y "
hence aaaa: "y = ?xn ∨ y = ?newma ∨ (both_member_options (?newlist ! (high y n)) (low y n) ∧ high y n < length ?newlist)"
by (smt (z3) Suc_1 Suc_le_D ‹deg div 2 = n› both_member_options_def dp membermima.simps(4) naive_member.simps(3))
show " x ≠ y ∧ both_member_options (Node (Some (mi, ma)) deg treeList summary) y"
proof-
have "y = ?xn ⟹?thesis"
using ‹x = mi› minxnrel xnin by blast
moreover have " y = ?newma ⟹ ?thesis"
proof-
assume "y = ?newma"
show ?thesis
proof(cases "?xn = ma")
case True
hence aaa:"?newma =?h * 2 ^ (deg div 2) +the(vebt_maxt(?newlist ! ?h))"
by metis
have "?newlist ! ?h = ?newnode" using hprolist by blast
obtain maxi where maxidef:"Some maxi = vebt_maxt(?newlist ! ?h)"
by (metis False hprolist vebt_maxt.elims minNull.simps(1) minNull.simps(4))
have aa:"invar_vebt (treeList ! ?h) n"
by (metis "5.IH"(1) ‹high ?xn n < length treeList› inthall member_def)
moreover hence ab:"maxi ≠ ?l ∧ both_member_options ?newnode maxi"
by (metis "5.IH"(1) ‹high ?xn n < length treeList› hprolist inthall maxbmo maxidef member_def)
ultimately have ac:"maxi ≠ ?l ∧ both_member_options (treeList ! ?h) maxi"
by (metis "5.IH"(1) ‹high ?xn n < length treeList› inthall member_def)
hence ad:"maxi < 2^n"
using ‹invar_vebt (treeList ! high ?xn n) n› member_bound valid_member_both_member_options by blast
then show ?thesis using Suc_1 aaa ‹y = ?newma› ac add_leD1
both_member_options_from_chilf_to_complete_tree dp option.sel high_inv low_inv maxidef plus_1_eq_Suc
by (metis (no_types, lifting) True ‹Some lx = vebt_mint (treeList ! summin)›
‹deg div 2 = n› ‹high (summin * 2 ^ n + lx) n < length treeList›
‹vebt_member (treeList ! summin) lx› ‹invar_vebt (treeList ! summin) n›
‹x = mi› leD member_bound mimapr mint_corr_help nat_add_left_cancel_le
valid_member_both_member_options)
next
case False
then show ?thesis
by (metis ‹mi ≤ x ∧ x ≤ ma› ‹x = mi› ‹y = ?newma› both_member_options_equiv_member leD vebt_maxt.simps(3) maxt_member mimapr tvalid)
qed
qed
moreover have "(both_member_options (?newlist ! (high y n)) (low y n)∧ high y n < length ?newlist) ⟹ ?thesis"
proof-
assume assmy:"(both_member_options (?newlist ! (high y n)) (low y n)∧ high y n < length ?newlist)"
then show ?thesis
proof(cases "high y n = ?h")
case True
hence "?newlist ! (high y n) = ?newnode"
using hprolist by presburger
have "invar_vebt (treeList ! ?h) n"
by (metis "5.IH"(1) ‹high ?xn n < length treeList› inthall member_def)
then show ?thesis
proof(cases "low y n= ?l")
case True
hence "y = ?xn"
using "5.IH"(1) ‹high (summin * 2 ^ n + lx) n < length treeList› ‹treeList [high (summin * 2 ^ n + lx) n := vebt_delete (treeList ! high (summin * 2 ^ n + lx) n) (low (summin * 2 ^ n + lx) n)] ! high y n = vebt_delete (treeList ! high (summin * 2 ^ n + lx) n) (low (summin * 2 ^ n + lx) n)› assmy by force
then show ?thesis
using calculation(1) by blast
next
case False
hence "low y n ≠ ?l ∧ both_member_options (treeList ! ?h ) (low y n)" using assmy
by (metis "5.IH"(1) "5.hyps"(2) ‹?newlist ! high y n = vebt_delete (treeList ! high (summin * 2 ^ n + lx) n) (low (summin * 2 ^ n + lx) n)› ‹vebt_member (treeList ! summin) lx› ‹summin < 2 ^ m› high_inv inthall member_bound member_def)
then show ?thesis
by (metis "5.hyps"(2) "5.hyps"(9) Suc_1 Suc_leD True ‹deg div 2 = n› ‹high (summin * 2 ^ n + lx) n < length treeList› ‹mi ≤ x ∧ x ≤ ma› ‹x = mi› both_member_options_from_chilf_to_complete_tree dp leD mimapr)
qed
next
case False
hence "?newlist ! (high y n) = treeList !(high y n)"
using "5.hyps"(2) ‹length treeList = length ?newlist› assmy nothprolist by presburger
hence "both_member_options (treeList !(high y n)) (low y n)"
using assmy by presburger
moreover have "x ≠ y"
by (metis "5.hyps"(1) "5.hyps"(4) "5.hyps"(9) ‹invar_vebt (treeList ! summin) n› ‹x < 2 ^ deg› ‹x = mi› calculation deg_not_0 exp_split_high_low(1) mimapr not_less_iff_gr_or_eq)
moreover have "high y n < length ?newlist" using assmy by blast
moreover hence "high y n < length treeList"
using ‹length treeList = length ?newlist› by presburger
ultimately show ?thesis
by (metis One_nat_def Suc_leD ‹deg div 2 = n› both_member_options_from_chilf_to_complete_tree dp numerals(2))
qed
qed
ultimately show ?thesis
using aaaa by fastforce
qed
qed
moreover have "(x ≠ y ∧ both_member_options (Node (Some (mi, ma)) deg treeList summary) y)⟹
both_member_options ?delsimp y"
proof-
assume assm: "x ≠ y ∧ both_member_options (Node (Some (mi, ma)) deg treeList summary) y"
hence abcv:"y = mi ∨ y = ma ∨ ( high y n < length treeList ∧ both_member_options (treeList ! (high y n)) (low y n))"
by (metis Suc_1 ‹deg div 2 = n› add_leD1 both_member_options_from_complete_tree_to_child member_inv plus_1_eq_Suc tvalid valid_member_both_member_options)
thus " both_member_options ?delsimp y"
proof-
have "y = mi ⟹ ?thesis"
using ‹x = mi› assm by blast
moreover have " y = ma ⟹ ?thesis"
by (smt (z3) Suc_1 Suc_le_D both_member_options_def dp membermima.simps(4))
moreover have " ( high y n < length treeList ∧ both_member_options (treeList ! (high y n)) (low y n))
⟹ ?thesis"
proof-
assume myass: "( high y n < length treeList ∧ both_member_options (treeList ! (high y n)) (low y n)) "
thus ?thesis
proof(cases "high y n = ?h")
case True
then show ?thesis
proof(cases "low y n = ?l")
case True
then show ?thesis
by (smt (z3) "5.hyps"(3) "5.hyps"(4) Suc_1 ‹deg div 2 = n› ‹length treeList = length (treeList [high (summin * 2 ^ n + lx) n := vebt_delete (treeList ! high (summin * 2 ^ n + lx) n) (low (summin * 2 ^ n + lx) n)])› add_Suc_right add_leD1 bit_split_inv both_member_options_def both_member_options_from_chilf_to_complete_tree dp membermima.simps(4) myass nth_list_update_neq plus_1_eq_Suc)
next
case False
hence "low y n ≠ ?l" by simp
hence pp:"?newlist ! ?h = ?newnode"
using hprolist by blast
hence "invar_vebt (treeList ! ?h) n"
by (metis "5.IH"(1) ‹high ?xn n < length treeList› inthall member_def)
hence "both_member_options ?newnode (low y n)"
by (metis "5.IH"(1) True ‹high ?xn n < length treeList› ‹low y n ≠ low ?xn n› in_set_member inthall myass)
then show ?thesis
by (metis One_nat_def Suc_leD True ‹deg div 2 = n› ‹high (summin * 2 ^ n + lx) n < length treeList› ‹length treeList = length ?newlist› both_member_options_from_chilf_to_complete_tree dp numerals(2) pp)
qed
next
case False
have pp:"?newlist ! (high y n) = treeList ! (high y n)"
using nothprolist[of "high y n"] False "5.hyps"(2) myass by presburger
then show ?thesis
by (metis One_nat_def Suc_leD ‹deg div 2 = n› ‹length treeList = length ?newlist› abcv both_member_options_from_chilf_to_complete_tree calculation(1) calculation(2) dp numerals(2))
qed
qed
then show ?thesis
using abcv calculation(1) calculation(2) by fastforce
qed
qed
ultimately show ?thesis by metis
qed
qed
qed
qed
qed
end
corollary "invar_vebt t n ⟹ both_member_options t x ⟹ x ≠ y ⟹ both_member_options (vebt_delete t y) x"
using dele_bmo_cont_corr by blast
corollary "invar_vebt t n ⟹ both_member_options t x ⟹ ¬ both_member_options (vebt_delete t x) x "
by (simp add: dele_bmo_cont_corr)
corollary "invar_vebt t n ⟹ both_member_options (vebt_delete t y) x ⟹ both_member_options t x ∧ x ≠ y"
using dele_bmo_cont_corr by blast
end
end
Theory VEBT_DeleteCorrectness
theory VEBT_DeleteCorrectness imports VEBT_Delete
begin
context VEBT_internal begin
subsection ‹Validness Preservation›
theorem delete_pres_valid: "invar_vebt t n ⟹ invar_vebt (vebt_delete t x) n"
proof(induction t n arbitrary: x rule: invar_vebt.induct)
case (1 a b)
then show ?case
proof(cases x)
case 0
then show ?thesis
by (simp add: invar_vebt.intros(1))
next
case (Suc prex)
hence "x = Suc prex" by simp
then show ?thesis
proof(cases prex)
case 0
then show ?thesis
by (simp add: Suc invar_vebt.intros(1))
next
case (Suc preprex)
then show ?thesis
by (simp add: ‹x = Suc prex› invar_vebt.intros(1))
qed
qed
next
case (2 treeList n summary m deg)
then show ?case
using invar_vebt.intros(2) by force
next
case (3 treeList n summary m deg)
then show ?case
using invar_vebt.intros(3) by auto
next
case (4 treeList n summary m deg mi ma)
hence 0: "( ∀ t ∈ set treeList. invar_vebt t n)" and 1: " invar_vebt summary m" and 2:"length treeList = 2^m" and 3:" deg = n+m" and
4: "(∀ i < 2^m. (∃ y. both_member_options (treeList ! i) y) ⟷ ( both_member_options summary i))" and
5: "(mi = ma ⟶ (∀ t ∈ set treeList. ∄ y. both_member_options t y))" and 6:"mi ≤ ma ∧ ma < 2^deg" and
7: "(mi ≠ ma ⟶ (∀ i < 2^m. (high ma n = i ⟶ both_member_options (treeList ! i) (low ma n)) ∧
(∀ y. (high y n = i ∧ both_member_options (treeList ! i) (low y n) ) ⟶ mi < y ∧ y ≤ ma)))"
and 8: "n = m" and 9: "deg div 2 = n" using "4" add_self_div_2 by auto
hence 10: "invar_vebt (Node (Some (mi, ma)) deg treeList summary) deg"
using invar_vebt.intros(4)[of treeList n summary m deg mi ma] by blast
hence 11:"n ≥ 1 " and 12: " deg ≥ 2"
by (metis "1" "8" "9" One_nat_def Suc_leI deg_not_0 div_greater_zero_iff)+
then show ?case
proof(cases "(x < mi ∨ x > ma)")
case True
hence "vebt_delete (Node (Some (mi, ma)) deg treeList summary) x = (Node (Some (mi, ma)) deg treeList summary)"
using delt_out_of_range[of x mi ma deg treeList summary]
using "1" "4.hyps"(3) "9" deg_not_0 div_greater_zero_iff by blast
then show ?thesis
by (simp add: "10")
next
case False
hence inrg: "mi≤ x ∧ x ≤ ma" by simp
then show ?thesis
proof(cases "x = mi ∧ x = ma")
case True
hence" (∀ t ∈ set treeList. ∄ y. both_member_options t y)"
using "5" by blast
moreover have "vebt_delete (Node (Some (mi, ma)) deg treeList summary) x = (Node None deg treeList summary)"
using del_single_cont[of x mi ma deg treeList summary] "1" "8" "9" True deg_not_0 div_greater_zero_iff by blast
moreover have " (∄ i. both_member_options summary i)"
using "10" True mi_eq_ma_no_ch by blast
ultimately show ?thesis
using "0" "1" "2" "3" "4.hyps"(3) invar_vebt.intros(2) by force
next
case False
hence "x ≠ mi ∨ x ≠ ma" by simp
hence "mi ≠ ma ∧ x < 2^deg"
by (metis "6" inrg le_antisym le_less_trans)
hence "7b": "(∀ i < 2^m. (high ma n = i ⟶ both_member_options (treeList ! i) (low ma n)) ∧
(∀ y. (high y n = i ∧ both_member_options (treeList ! i) (low y n) ) ⟶ mi < y ∧ y ≤ ma))"
using "7" by fastforce
hence "both_member_options (treeList ! (high ma n)) (low ma n)"
using "1" "3" "6" "8" deg_not_0 exp_split_high_low(1) by blast
hence yhelper:"both_member_options (treeList ! (high y n)) (low y n)
⟹ high y n < 2^m ⟹ mi < y ∧ y ≤ ma ∧ low y n < 2^n" for y
by (simp add: "7b" low_def)
then show ?thesis
proof(cases "x ≠ mi")
case True
hence xnotmi: "x ≠ mi" by simp
let ?h = "high x n"
let ?l = "low x n"
have hlbound:"?h < 2^m ∧ ?l < 2^n"
using "1" "3" "8" ‹mi ≠ ma ∧ x < 2 ^ deg› deg_not_0 exp_split_high_low(1) exp_split_high_low(2) by blast
let ?newnode = "vebt_delete (treeList ! ?h) ?l"
have "treeList ! ?h ∈ set treeList "
by (metis "2" hlbound in_set_member inthall)
hence nnvalid: "invar_vebt ?newnode n"
by (simp add: "4.IH"(1))
let ?newlist = "treeList[?h:= ?newnode]"
have hlist:"?newlist ! ?h = ?newnode"
by (simp add: "2" hlbound)
have nothlist:"i ≠ ?h ⟹ i < 2^m ⟹ ?newlist ! i = treeList ! i" for i by simp
have allvalidinlist:"∀ t ∈ set ?newlist. invar_vebt t n"
proof
fix t
assume "t ∈ set ?newlist"
then obtain i where "i< 2^m ∧ ?newlist ! i = t"
by (metis "2" in_set_conv_nth length_list_update)
show "invar_vebt t n"
by (metis "0" "2" ‹i < 2 ^ m ∧ treeList[high x n := vebt_delete (treeList ! high x n) (low x n)] ! i = t› hlist nnvalid nth_list_update_neq nth_mem)
qed
have newlistlength: "length ?newlist = 2^m" using 2 by auto
then show ?thesis
proof(cases "minNull ?newnode")
case True
hence ninNullc: "minNull ?newnode" by simp
let ?sn = "vebt_delete summary ?h"
let ?newma= "(if x = ma then (let maxs = vebt_maxt ?sn in
(if maxs = None
then mi
else 2^(deg div 2) * the maxs
+ the (vebt_maxt (?newlist ! the maxs))
)
)
else ma)"
let ?delsimp =" (Node (Some (mi, ?newma)) deg ?newlist ?sn)"
have dsimp:"vebt_delete (Node (Some (mi, ma)) deg treeList summary) x = ?delsimp"
using del_x_not_mi_new_node_nil[of mi x ma deg ?h ?l ?newnode treeList ?sn summary ?newlist]
hlbound 9 11 12 True 2 inrg xnotmi by simp
have newsummvalid: "invar_vebt ?sn m"
by (simp add: "4.IH"(2))
have 111: "(∀ i < 2^m. (∃ x. both_member_options (?newlist ! i) x) ⟷ ( both_member_options ?sn i))"
proof
fix i
show " i < 2^m ⟶ ((∃ x. both_member_options (?newlist ! i) x) = ( both_member_options ?sn i))"
proof
assume "i < 2^m"
show "(∃ x. both_member_options (?newlist ! i) x) = ( both_member_options ?sn i)"
proof(cases "i = ?h")
case True
hence 1000:"?newlist ! i = ?newnode"
using hlist by blast
hence 1001:"∄ x. vebt_member (?newlist ! i) x"
by (simp add: min_Null_member ninNullc)
hence 1002: "∄ x. both_member_options (?newlist ! i) x"
using "1000" nnvalid valid_member_both_member_options by auto
have 1003: "¬ both_member_options ?sn i"
using "1" True dele_bmo_cont_corr by auto
then show ?thesis
using "1002" by blast
next
case False
hence 1000:"?newlist ! i = treeList ! i"
using ‹i < 2 ^ m› nothlist by blast
hence "both_member_options (?newlist ! i) y ⟹ both_member_options ?sn i" for y
proof-
assume "both_member_options (?newlist ! i) y"
hence "both_member_options summary i"
using "1000" "4" ‹i < 2 ^ m› by auto
thus "both_member_options ?sn i"
using "1" False dele_bmo_cont_corr by blast
qed
moreover have "both_member_options ?sn i ⟹ ∃ y. both_member_options (?newlist ! i) y"
proof-
assume "both_member_options ?sn i "
hence "both_member_options summary i"
using "1" dele_bmo_cont_corr by auto
thus " ∃ y. both_member_options (?newlist ! i) y"
using "1000" "4" ‹i < 2 ^ m› by presburger
qed
then show ?thesis
using calculation by blast
qed
qed
qed
have 112:" (mi = ?newma ⟶ (∀ t ∈ set ?newlist. ∄ x. both_member_options t x))"
proof
assume aampt:"mi = ?newma"
show "(∀ t ∈ set ?newlist. ∄ y. both_member_options t y)"
proof(cases "x = ma")
case True
let ?maxs = "vebt_maxt ?sn"
show ?thesis
proof(cases "?maxs = None")
case True
hence aa:"∄ y. vebt_member ?sn y"
using maxt_corr_help_empty newsummvalid set_vebt'_def by auto
hence "∄ y. both_member_options ?sn y"
using newsummvalid valid_member_both_member_options by blast
hence "t ∈ set ?newlist ⟹ ∄y. both_member_options t y" for t
proof-
assume "t ∈ set ?newlist"
then obtain i where "?newlist ! i = t ∧ i< 2^m"
by (metis in_set_conv_nth newlistlength)
thus " ∄y. both_member_options t y"
using "111" ‹∄y. both_member_options (vebt_delete summary (high x n)) y› by blast
qed
then show ?thesis by blast
next
case False
then obtain maxs where "Some maxs = ?maxs"
by fastforce
hence "both_member_options summary maxs"
by (metis "1" dele_bmo_cont_corr maxbmo)
have bb:"maxs ≠ ?h ∧ maxs < 2^m"
by (metis "1" ‹Some maxs = vebt_maxt ?sn› dele_bmo_cont_corr maxbmo member_bound valid_member_both_member_options)
hence "invar_vebt (?newlist ! maxs) n"using 0 "2" by auto
hence "∃ y. both_member_options (?newlist ! maxs) y"
using "4" bb ‹both_member_options summary maxs› nothlist by presburger
then obtain maxi where "Some maxi = vebt_maxt (?newlist ! maxs)" using
‹invar_vebt (treeList[high x n := vebt_delete (treeList ! high x n) (low x n)] ! maxs) n›
empty_Collect_eq option.sel maxt_corr_help_empty set_vebt'_def valid_member_both_member_options by fastforce
hence "maxs = high mi n ∧ both_member_options (?newlist ! maxs) (low mi n)"
by (smt (z3) "9" True ‹Some maxs = vebt_maxt (vebt_delete summary (high x n))› ‹invar_vebt (treeList[high x n := vebt_delete (treeList ! high x n) (low x n)] ! maxs) n› aampt option.sel high_inv low_inv maxbmo member_bound mult.commute option.distinct(1) valid_member_both_member_options)
hence False
by (metis bb nat_less_le nothlist yhelper)
then show ?thesis by simp
qed
next
case False
then show ?thesis
using ‹mi ≠ ma ∧ x < 2 ^ deg› aampt by presburger
qed
qed
have 114: "?newma < 2^deg ∧ mi ≤ ?newma"
proof(cases "x = ma")
case True
hence "x = ma" by simp
let ?maxs = "vebt_maxt ?sn"
show ?thesis
proof(cases "?maxs = None")
case True
then show ?thesis
using "6" by fastforce
next
case False
then obtain maxs where "Some maxs = ?maxs"
by fastforce
hence "both_member_options summary maxs"
by (metis "1" dele_bmo_cont_corr maxbmo)
have bb:"maxs ≠ ?h ∧ maxs < 2^m"
by (metis "1" ‹Some maxs = vebt_maxt ?sn› dele_bmo_cont_corr maxbmo member_bound valid_member_both_member_options)
hence "invar_vebt (?newlist ! maxs) n"using 0 "2" by auto
hence "∃ y. both_member_options (?newlist ! maxs) y"
using "4" bb ‹both_member_options summary maxs› nothlist by presburger
then obtain maxi where "Some maxi = vebt_maxt (?newlist ! maxs)"
by (metis ‹invar_vebt (treeList[high x n := vebt_delete (treeList ! high x n) (low x n)] ! maxs) n› empty_Collect_eq maxt_corr_help_empty option_shift.elims set_vebt'_def valid_member_both_member_options)
then show ?thesis
by (smt (verit, best) "6" "9" ‹Some maxs = vebt_maxt (vebt_delete summary (high x n))› ‹invar_vebt (?newlist ! maxs) n› bb option.sel high_inv less_le_trans low_inv maxbmo maxt_member member_bound mult.commute not_less_iff_gr_or_eq nothlist verit_comp_simplify1(3) yhelper)
qed
next
case False
then show ?thesis
using "6" by auto
qed
have 115: "mi ≠ ?newma ⟶
(∀ i < 2^m.
(high ?newma n = i ⟶ both_member_options (?newlist ! i) (low ?newma n)) ∧
(∀ y. (high y n = i ∧ both_member_options (?newlist ! i) (low y n) ) ⟶ mi < y ∧ y ≤ ?newma))"
proof
assume "mi ≠ ?newma"
show " (∀ i < 2^m.
(high ?newma n = i ⟶ both_member_options (?newlist ! i) (low ?newma n)) ∧
(∀ y. (high y n = i ∧ both_member_options (?newlist ! i) (low y n) ) ⟶ mi < y ∧ y ≤ ?newma))"
proof
fix i
show "i < 2^m ⟶
(high ?newma n = i ⟶ both_member_options (?newlist ! i) (low ?newma n)) ∧
(∀ y. (high y n = i ∧ both_member_options (?newlist ! i) (low y n) ) ⟶ mi < y ∧ y ≤ ?newma)"
proof
assume assumption:"i < 2^m"
show " (high ?newma n = i ⟶ both_member_options (?newlist ! i) (low ?newma n)) ∧
(∀ y. (high y n = i ∧ both_member_options (?newlist ! i) (low y n) ) ⟶ mi < y ∧ y ≤ ?newma)"
proof-
have "(high ?newma n = i ⟶ both_member_options (?newlist ! i) (low ?newma n))"
proof
assume newmaassm: "high ?newma n = i"
thus " both_member_options (?newlist ! i) (low ?newma n)"
proof(cases "x = ma" )
case True
let ?maxs = "vebt_maxt ?sn"
show ?thesis
proof(cases "?maxs = None")
case True
then show ?thesis
by (smt (z3) "0" ‹both_member_options (treeList ! high ma n) (low ma n)› ‹mi ≠ (if x = ma then let maxs = vebt_maxt (vebt_delete summary (high x n)) in if maxs = None then mi else 2 ^ (deg div 2) * the maxs + the (vebt_maxt (treeList [high x n := vebt_delete (treeList ! high x n) (low x n)] ! the maxs)) else ma)› ‹treeList ! high x n ∈ set treeList› bit_split_inv dele_bmo_cont_corr hlist newmaassm nth_list_update_neq)
next
case False
then obtain maxs where "Some maxs = ?maxs"
by fastforce
hence "both_member_options summary maxs"
by (metis "1" dele_bmo_cont_corr maxbmo)
have bb:"maxs ≠ ?h ∧ maxs < 2^m"
by (metis "1" ‹Some maxs = vebt_maxt ?sn› dele_bmo_cont_corr maxbmo member_bound valid_member_both_member_options)
hence "invar_vebt (?newlist ! maxs) n"using 0 2 by auto
hence "∃ y. both_member_options (?newlist ! maxs) y"
using "4" bb ‹both_member_options summary maxs› nothlist by presburger
then obtain maxi where "Some maxi = vebt_maxt (?newlist ! maxs)" using
‹invar_vebt (treeList[high x n := vebt_delete (treeList ! high x n) (low x n)] ! maxs) n›
empty_Collect_eq maxt_corr_help_empty set_vebt'_def valid_member_both_member_options
by (smt (z3) VEBT_Member.vebt_member.simps(2) ‹invar_vebt (treeList[high x n := vebt_delete (treeList ! high x n) (low x n)] ! maxs) n› vebt_maxt.elims minNull.simps(1) min_Null_member valid_member_both_member_options)
then show ?thesis
by (smt (z3) "9" False True ‹Some maxs = vebt_maxt (vebt_delete summary (high x n))› ‹invar_vebt (treeList[high x n := vebt_delete (treeList ! high x n) (low x n)] ! maxs) n› option.sel high_inv low_inv maxbmo maxt_member member_bound mult.commute newmaassm)
qed
next
case False
then show ?thesis
by (smt (z3) "0" ‹both_member_options (treeList ! high ma n) (low ma n)› ‹treeList ! high x n ∈ set treeList› assumption bit_split_inv dele_bmo_cont_corr hlist newmaassm nothlist)
qed
qed
moreover have " (∀ y. (high y n = i ∧ both_member_options (?newlist ! i) (low y n) ) ⟶ mi < y ∧ y ≤ ?newma)"
proof
fix y
show "(high y n = i ∧ both_member_options (?newlist ! i) (low y n) ) ⟶ mi < y ∧ y ≤ ?newma"
proof
assume yassm: "(high y n = i ∧ both_member_options (?newlist ! i) (low y n) )"
hence "mi < y"
proof(cases "i = ?h")
case True
hence "both_member_options (treeList ! i) (low y n)"
using "0" ‹treeList ! high x n ∈ set treeList› dele_bmo_cont_corr hlist yassm by auto
then show ?thesis
by (simp add: assumption yassm yhelper)
next
case False
then show ?thesis
using assumption nothlist yassm yhelper by presburger
qed
moreover have "y ≤ ?newma"
proof(cases "x = ma")
case True
hence "x= ma" by simp
let ?maxs = "vebt_maxt ?sn"
show ?thesis
proof(cases "?maxs = None")
case True
then show ?thesis
using ‹mi ≠ ?newma› ‹x = ma› by presburger
next
case False
then obtain maxs where "Some maxs = ?maxs"
by fastforce
hence "both_member_options summary maxs"
by (metis "1" dele_bmo_cont_corr maxbmo)
have bb:"maxs ≠ ?h ∧ maxs < 2^m"
by (metis "1" ‹Some maxs = vebt_maxt ?sn› dele_bmo_cont_corr maxbmo member_bound valid_member_both_member_options)
hence "invar_vebt (?newlist ! maxs) n"using 0 2 by auto
hence "∃ y. both_member_options (?newlist ! maxs) y"
using "4" bb ‹both_member_options summary maxs› nothlist by presburger
then obtain maxi where "Some maxi = vebt_maxt (?newlist ! maxs)"
by (metis "2" "4.IH"(1) Collect_empty_eq bb both_member_options_equiv_member maxt_corr_help_empty nth_list_update_neq nth_mem option.exhaust set_vebt'_def)
hence "maxs < 2^m ∧ maxi < 2^n"
by (metis ‹invar_vebt (?newlist ! maxs) n› bb maxt_member member_bound)
hence "?newma = 2^n* maxs + maxi"
by (smt (z3) "9" False True ‹Some maxi = vebt_maxt (?newlist ! maxs)› ‹Some maxs = vebt_maxt (vebt_delete summary (high x n))› option.sel)
hence "low ?newma n = maxi ∧ high ?newma n = maxs"
by (simp add: ‹maxs < 2 ^ m ∧ maxi < 2 ^ n› high_inv low_inv mult.commute)
hence "both_member_options (treeList ! (high y n)) (low y n)"
by (metis "0" ‹treeList ! high x n ∈ set treeList› assumption dele_bmo_cont_corr hlist nothlist yassm)
hence hleqdraft:"high y n > maxs ⟹ False"
proof-
assume "high y n > maxs"
have "both_member_options summary (high y n)"
using "1" "111" assumption dele_bmo_cont_corr yassm by blast
moreover have "both_member_options ?sn (high y n)"
using "111" assumption yassm by blast
ultimately show False
by (metis ‹Some maxs = vebt_maxt (vebt_delete summary (high x n))› ‹maxs < high y n› leD maxt_corr_help newsummvalid valid_member_both_member_options)
qed
hence hleqmaxs: "high y n ≤ maxs" by presburger
then show ?thesis
proof(cases "high y n = maxs")
case True
hence "low y n ≤ maxi"
by (metis ‹Some maxi = vebt_maxt (treeList[high x n := vebt_delete (treeList ! high x n) (low x n)] ! maxs)› ‹invar_vebt (treeList[high x n := vebt_delete (treeList ! high x n) (low x n)] ! maxs) n› maxt_corr_help valid_member_both_member_options yassm)
then show ?thesis
by (smt (z3) True ‹(if x = ma then let maxs = vebt_maxt (vebt_delete summary (high x n)) in if maxs = None then mi else 2 ^ (deg div 2) * the maxs + the (vebt_maxt ((?newlist) ! the maxs)) else ma) = 2 ^ n * maxs + maxi› add_le_cancel_left bit_concat_def bit_split_inv mult.commute)
next
case False
then show ?thesis
by (metis ‹low (if x = ma then let maxs = vebt_maxt (vebt_delete summary (high x n)) in if maxs = None then mi else 2 ^ (deg div 2) * the maxs + the (vebt_maxt ((?newlist) ! the maxs)) else ma) n = maxi ∧ high (if x = ma then let maxs = vebt_maxt (vebt_delete summary (high x n)) in if maxs = None then mi else 2 ^ (deg div 2) * the maxs + the (vebt_maxt ((?newlist) ! the maxs)) else ma) n = maxs› div_le_mono high_def hleqdraft le_neq_implies_less nat_le_linear)
qed
qed
next
case False
then show ?thesis
by (smt (z3) "0" ‹treeList ! high x n ∈ set treeList› assumption dele_bmo_cont_corr hlist nothlist yassm yhelper)
qed
ultimately show " mi < y ∧ y ≤ ?newma" by simp
qed
qed
ultimately show ?thesis by simp
qed
qed
qed
qed
hence 117: "?newma < 2^deg" and 118: "mi ≤ ?newma" using 114 by auto
have 116: " invar_vebt (Node (Some (mi, ?newma)) deg ?newlist ?sn) deg"
using invar_vebt.intros(4)[of ?newlist n ?sn m deg mi ?newma]
using 3 allvalidinlist newlistlength newsummvalid "4.hyps"(3) 111 112 118 117 115 by fastforce
show ?thesis
using "116" dsimp by presburger
next
case False
hence notemp:"∃ z. both_member_options ?newnode z"
using not_min_Null_member by auto
let ?newma = "(if x = ma then
?h * 2^(deg div 2) + the( vebt_maxt (?newlist ! ?h))
else ma)"
let ?delsimp =" (Node (Some (mi, ?newma)) deg ?newlist summary)"
have dsimp:"vebt_delete (Node (Some (mi, ma)) deg treeList summary) x = ?delsimp"
using del_x_not_mi_newnode_not_nil[of mi x ma deg ?h ?l ?newnode treeList ?newlist summary]
by (metis "12" "2" "9" False dual_order.eq_iff hlbound inrg order.not_eq_order_implies_strict xnotmi)
have 111: "(∀ i < 2^m. (∃ x. both_member_options (?newlist ! i) x) ⟷ ( both_member_options summary i))"
proof
fix i
show " i < 2^m ⟶ ((∃ x. both_member_options (?newlist ! i) x) = ( both_member_options summary i))"
proof
assume "i < 2^m"
show "(∃ x. both_member_options (?newlist ! i) x) = ( both_member_options summary i)"
proof(cases "i = ?h")
case True
hence 1000:"?newlist ! i = ?newnode"
using hlist by blast
hence 1001:"∃ x. vebt_member (?newlist ! i) x"
using nnvalid notemp valid_member_both_member_options by auto
hence 1002: "∃ x. both_member_options (?newlist ! i) x"
using "1000" notemp by presburger
have 1003: "both_member_options summary i"
using "0" "1000" "1002" "4" True ‹i < 2 ^ m› ‹treeList ! high x n ∈ set treeList› dele_bmo_cont_corr by fastforce
then show ?thesis
using "1002" by blast
next
case False
hence 1000:"?newlist ! i = treeList ! i"
using ‹i < 2 ^ m› nothlist by blast
then show ?thesis
using "4" ‹i < 2 ^ m› by presburger
qed
qed
qed
have 112:" (mi = ?newma ⟶ (∀ t ∈ set ?newlist. ∄ x. both_member_options t x))"
proof
assume aampt:"mi = ?newma"
show "(∀ t ∈ set ?newlist. ∄ y. both_member_options t y)"
proof(cases "x = ma")
case True
obtain maxi where " vebt_maxt (?newlist ! ?h) = Some maxi"
by (metis False VEBT_Member.vebt_member.simps(2) hlist vebt_maxt.elims minNull.simps(1) nnvalid notemp valid_member_both_member_options)
hence "both_member_options ?newnode maxi"
using hlist maxbmo by auto
hence "both_member_options (treeList ! ?h) maxi"
using "0" ‹treeList ! high x n ∈ set treeList› dele_bmo_cont_corr by blast
hence False
by (metis "9" True ‹both_member_options ?newnode maxi› ‹vebt_maxt (?newlist ! high x n) = Some maxi› aampt option.sel high_inv hlbound low_inv member_bound nnvalid not_less_iff_gr_or_eq valid_member_both_member_options yhelper)
then show ?thesis by blast
next
case False
then show ?thesis
using ‹mi ≠ ma ∧ x < 2 ^ deg› aampt by presburger
qed
qed
have 114: "?newma < 2^deg ∧ mi ≤ ?newma"
proof(cases "x = ma")
case True
hence "x = ma" by simp
obtain maxi where " vebt_maxt (?newlist ! ?h) = Some maxi"
by (metis empty_Collect_eq hlist maxt_corr_help_empty nnvalid notemp option.exhaust set_vebt'_def valid_member_both_member_options)
hence "both_member_options ?newnode maxi"
using hlist maxbmo by auto
hence "both_member_options (treeList ! ?h) maxi"
using "0" ‹treeList ! high x n ∈ set treeList› dele_bmo_cont_corr by blast
hence "maxi < 2^n"
using ‹both_member_options?newnode maxi› member_bound nnvalid valid_member_both_member_options by blast
show ?thesis
by (smt (z3) "3" "9" Euclidean_Division.div_eq_0_iff True ‹both_member_options (treeList ! high x n) maxi› ‹maxi < 2 ^ n› ‹vebt_maxt (?newlist ! high x n) = Some maxi› add.right_neutral div_exp_eq div_mult_self3 option.sel high_inv hlbound le_0_eq less_imp_le_nat low_inv power_not_zero rel_simps(28) yhelper)
next
case False
then show ?thesis
using "6" by auto
qed
have 115: "mi ≠ ?newma ⟶
(∀ i < 2^m.
(high ?newma n = i ⟶ both_member_options (?newlist ! i) (low ?newma n)) ∧
(∀ y. (high y n = i ∧ both_member_options (?newlist ! i) (low y n) ) ⟶ mi < y ∧ y ≤ ?newma))"
proof
assume "mi ≠ ?newma"
show " (∀ i < 2^m.
(high ?newma n = i ⟶ both_member_options (?newlist ! i) (low ?newma n)) ∧
(∀ y. (high y n = i ∧ both_member_options (?newlist ! i) (low y n) ) ⟶ mi < y ∧ y ≤ ?newma))"
proof
fix i
show "i < 2^m ⟶
(high ?newma n = i ⟶ both_member_options (?newlist ! i) (low ?newma n)) ∧
(∀ y. (high y n = i ∧ both_member_options (?newlist ! i) (low y n) ) ⟶ mi < y ∧ y ≤ ?newma)"
proof
assume assumption:"i < 2^m"
show " (high ?newma n = i ⟶ both_member_options (?newlist ! i) (low ?newma n)) ∧
(∀ y. (high y n = i ∧ both_member_options (?newlist ! i) (low y n) ) ⟶ mi < y ∧ y ≤ ?newma)"
proof-
have "(high ?newma n = i ⟶ both_member_options (?newlist ! i) (low ?newma n))"
proof
assume newmaassm: "high ?newma n = i"
thus " both_member_options (?newlist ! i) (low ?newma n)"
proof(cases "x = ma")
case True
obtain maxi where "vebt_maxt (?newlist ! ?h) = Some maxi"
by (metis Collect_empty_eq both_member_options_equiv_member hlist maxt_corr_help_empty nnvalid not_Some_eq notemp set_vebt'_def)
hence "both_member_options (?newlist ! ?h) maxi"
using maxbmo by blast
then show ?thesis
by (smt (z3) "9" True ‹vebt_maxt (?newlist ! high x n) = Some maxi› option.sel high_inv hlist low_inv maxt_member member_bound newmaassm nnvalid)
next
case False
then show ?thesis
by (smt (z3) "0" ‹both_member_options (treeList ! high ma n) (low ma n)› ‹treeList ! high x n ∈ set treeList› assumption bit_split_inv dele_bmo_cont_corr hlist newmaassm nothlist)
qed
qed
moreover have " (∀ y. (high y n = i ∧ both_member_options (?newlist ! i) (low y n) ) ⟶ mi < y ∧ y ≤ ?newma)"
proof
fix y
show "(high y n = i ∧ both_member_options (?newlist ! i) (low y n) ) ⟶ mi < y ∧ y ≤ ?newma"
proof
assume yassm: "(high y n = i ∧ both_member_options (?newlist ! i) (low y n) )"
hence "mi < y"
proof(cases "i = ?h")
case True
hence "both_member_options (treeList ! i) (low y n)"
using "0" ‹treeList ! high x n ∈ set treeList› dele_bmo_cont_corr hlist yassm by auto
then show ?thesis
by (simp add: assumption yassm yhelper)
next
case False
then show ?thesis
using assumption nothlist yassm yhelper by presburger
qed
moreover have "y ≤ ?newma"
proof(cases "x = ma")
case True
hence "x= ma" by simp
obtain maxi where "vebt_maxt (?newlist ! ?h) = Some maxi"
by (metis Collect_empty_eq both_member_options_equiv_member hlist maxt_corr_help_empty nnvalid not_Some_eq notemp set_vebt'_def)
hence "both_member_options (?newlist ! ?h) maxi"
using maxbmo by blast
have "high y n ≤ ?h"
by (metis "7b" True assumption div_le_mono high_def nothlist yassm)
then show ?thesis
proof(cases "high y n = ?h")
case True
have "low y n > maxi ⟹ False"
by (metis True ‹vebt_maxt (?newlist ! ?h) = Some maxi› hlist leD maxt_corr_help nnvalid valid_member_both_member_options yassm)
then show ?thesis
by (smt (z3) "9" True ‹vebt_maxt (?newlist ! ?h) = Some maxi› ‹x = ma› add_le_cancel_left div_mult_mod_eq option.sel high_def low_def nat_le_linear nat_less_le)
next
case False
then show ?thesis
by (smt (z3) "9" True ‹both_member_options (?newlist ! high x n) maxi› ‹high y n ≤ high x n› ‹vebt_maxt (?newlist ! high x n) = Some maxi› div_le_mono option.sel high_def high_inv hlist le_antisym member_bound nat_le_linear nnvalid valid_member_both_member_options)
qed
next
case False
then show ?thesis
by (smt (z3) "0" ‹treeList ! high x n ∈ set treeList› assumption dele_bmo_cont_corr hlist nothlist yassm yhelper)
qed
ultimately show " mi < y ∧ y ≤ ?newma" by simp
qed
qed
ultimately show ?thesis by simp
qed
qed
qed
qed
hence 117: "?newma < 2^deg" and 118: "mi ≤ ?newma" using 114 by auto
have 116: " invar_vebt (Node (Some (mi, ?newma)) deg ?newlist summary) deg"
using invar_vebt.intros(4)[of ?newlist n summary m deg mi ?newma] allvalidinlist
1 newlistlength 8 3 111 112 117 118 115 by fastforce
then show ?thesis
using dsimp by presburger
qed
next
case False
hence xmi:"x = mi" by simp
have "both_member_options summary (high ma n)"
using "1" "3" "4" "4.hyps"(3) "6" ‹both_member_options (treeList ! high ma n) (low ma n)› deg_not_0 exp_split_high_low(1) by blast
hence "vebt_member summary (high ma n)"
using "4.hyps"(1) valid_member_both_member_options by blast
obtain summin where "Some summin = vebt_mint summary"
by (metis "4.hyps"(1) ‹vebt_member summary (high ma n)› empty_Collect_eq mint_corr_help_empty not_None_eq set_vebt'_def)
hence "∃ z . both_member_options (treeList ! summin) z"
by (metis "4.hyps"(1) "4.hyps"(5) both_member_options_equiv_member member_bound mint_member)
moreover have "invar_vebt (treeList ! summin) n"
by (metis "0" "1" "2" ‹Some summin = vebt_mint summary› member_bound mint_member nth_mem)
ultimately obtain lx where "Some lx = vebt_mint (treeList ! summin)"
by (metis empty_Collect_eq mint_corr_help_empty not_None_eq set_vebt'_def valid_member_both_member_options)
let ?xn = "summin*2^n + lx"
have "?xn = (if x = mi
then the (vebt_mint summary) * 2^(deg div 2)
+ the (vebt_mint (treeList ! the (vebt_mint summary)))
else x)"
by (metis False ‹Some lx = vebt_mint (treeList ! summin)› ‹Some summin = vebt_mint summary› ‹deg div 2 = n› option.sel)
have "vebt_member (treeList ! summin) lx"
using ‹Some lx = vebt_mint (treeList ! summin)› ‹invar_vebt (treeList ! summin) n› mint_member by auto
moreover have "summin < 2^m"
by (metis "4.hyps"(1) ‹Some summin = vebt_mint summary› member_bound mint_member)
ultimately have xnin: "both_member_options (Node (Some (mi, ma)) deg treeList summary) ?xn"
by (metis "12" "2" "9" ‹invar_vebt (treeList ! summin) n› add_leD1 both_member_options_equiv_member both_member_options_from_chilf_to_complete_tree high_inv low_inv member_bound numeral_2_eq_2 plus_1_eq_Suc)
let ?h ="high ?xn n"
let ?l = "low ?xn n"
have "?xn < 2^deg"
by (smt (verit, ccfv_SIG) "4.hyps"(1) "4.hyps"(4) Euclidean_Division.div_eq_0_iff ‹Some lx = vebt_mint (treeList ! summin)› ‹Some summin = vebt_mint summary› ‹invar_vebt (treeList ! summin) n› div_exp_eq high_def high_inv le_0_eq member_bound mint_member not_numeral_le_zero power_not_zero)
hence "?h < length treeList"
using "4.hyps"(2) "4.hyps"(3) "4.hyps"(4) ‹invar_vebt (treeList ! summin) n› deg_not_0 exp_split_high_low(1) by metis
let ?newnode = "vebt_delete (treeList ! ?h) ?l"
let ?newlist = "treeList[?h:= ?newnode]"
have "length treeList = length ?newlist" by simp
hence hprolist: "?newlist ! ?h = ?newnode"
by (meson ‹high (summin * 2 ^ n + lx) n < length treeList› nth_list_update_eq)
have nothprolist: "i ≠ ?h ∧ i < 2^m ⟹ ?newlist ! i = treeList ! i" for i by simp
have hlbound:"?h < 2^m ∧ ?l < 2^n"
using "1" "2" "3" "8" ‹high (summin * 2 ^ n + lx) n < length treeList› ‹summin * 2 ^ n + lx < 2 ^ deg› deg_not_0 exp_split_high_low(2) by presburger
hence nnvalid: "invar_vebt ?newnode n"
by (metis "4.IH"(1) ‹high (summin * 2 ^ n + lx) n < length treeList› inthall member_def)
have allvalidinlist:"∀ t ∈ set ?newlist. invar_vebt t n"
proof
fix t
assume "t ∈ set ?newlist"
then obtain i where "i < 2^m ∧ ?newlist ! i = t"
by (metis "2" ‹length treeList = length (treeList [high (summin * 2 ^ n + lx) n := vebt_delete (treeList ! high (summin * 2 ^ n + lx) n) (low (summin * 2 ^ n + lx) n)])› in_set_conv_nth)
then show "invar_vebt t n"
by (metis "0" "2" hprolist nnvalid nth_list_update_neq nth_mem)
qed
have newlistlength: "length ?newlist = 2^m"
by (simp add: "2")
then show ?thesis
proof(cases "minNull ?newnode")
case True
hence ninNullc: "minNull ?newnode" by simp
let ?sn = "vebt_delete summary ?h"
let ?newma= "(if ?xn = ma then (let maxs = vebt_maxt ?sn in
(if maxs = None
then ?xn
else 2^(deg div 2) * the maxs
+ the (vebt_maxt (?newlist ! the maxs))
)
)
else ma)"
let ?delsimp =" (Node (Some (?xn, ?newma)) deg ?newlist ?sn)"
have dsimp:"vebt_delete (Node (Some (mi, ma)) deg treeList summary) x = ?delsimp"
using del_x_mi_lets_in_minNull[of x mi ma deg ?xn ?h summary treeList ?l ?newnode ?newlist ?sn]
by (metis "12" "9" ‹high (summin * 2 ^ n + lx) n < length treeList› ‹summin * 2 ^ n + lx = (if x = mi then the (vebt_mint summary) * 2 ^ (deg div 2) + the (vebt_mint (treeList ! the (vebt_mint summary))) else x)› ‹x = mi› ‹x ≠ mi ∨ x ≠ ma› inrg nat_less_le ninNullc)
have newsummvalid: "invar_vebt ?sn m"
by (simp add: "4.IH"(2))
have 111: "(∀ i < 2^m. (∃ x. both_member_options (?newlist ! i) x) ⟷ ( both_member_options ?sn i))"
proof
fix i
show " i < 2^m ⟶ ((∃ x. both_member_options (?newlist ! i) x) = ( both_member_options ?sn i))"
proof
assume "i < 2^m"
show "(∃ x. both_member_options (?newlist ! i) x) = ( both_member_options ?sn i)"
proof(cases "i = ?h")
case True
hence 1000:"?newlist ! i = ?newnode"
using hprolist by fastforce
hence 1001:"∄ x. vebt_member (?newlist ! i) x"
by (simp add: min_Null_member ninNullc)
hence 1002: "∄ x. both_member_options (?newlist ! i) x"
using "1000" nnvalid valid_member_both_member_options by auto
have 1003: "¬ both_member_options ?sn i"
using "1" True dele_bmo_cont_corr by auto
then show ?thesis
using "1002" by blast
next
case False
hence 1000:"?newlist ! i = treeList ! i"
using ‹i < 2 ^ m› nothprolist by blast
hence "both_member_options (?newlist ! i) y ⟹ both_member_options ?sn i" for y
proof-
assume "both_member_options (?newlist ! i) y"
hence "both_member_options summary i"
using "1000" "4" ‹i < 2 ^ m› by auto
thus "both_member_options ?sn i"
using "1" False dele_bmo_cont_corr by blast
qed
moreover have "both_member_options ?sn i ⟹ ∃ y. both_member_options (?newlist ! i) y"
proof-
assume "both_member_options ?sn i "
hence "both_member_options summary i"
using "1" dele_bmo_cont_corr by auto
thus " ∃ y. both_member_options (?newlist ! i) y"
using "1000" "4" ‹i < 2 ^ m› by presburger
qed
then show ?thesis
using calculation by blast
qed
qed
qed
have 112:" (?xn = ?newma ⟶ (∀ t ∈ set ?newlist. ∄ x. both_member_options t x))"
proof
assume aampt:"?xn = ?newma"
show "(∀ t ∈ set ?newlist. ∄ y. both_member_options t y)"
proof(cases "?xn = ma")
case True
let ?maxs = "vebt_maxt ?sn"
show ?thesis
proof(cases "?maxs = None")
case True
hence aa:"∄ y. vebt_member ?sn y"
using maxt_corr_help_empty newsummvalid set_vebt'_def by auto
hence "∄ y. both_member_options ?sn y"
using newsummvalid valid_member_both_member_options by blast
hence "t ∈ set ?newlist ⟹ ∄y. both_member_options t y" for t
proof-
assume "t ∈ set ?newlist"
then obtain i where "?newlist ! i = t ∧ i< 2^m"
by (metis "2" ‹length treeList = length (treeList [high (summin * 2 ^ n + lx) n := vebt_delete (treeList ! high (summin * 2 ^ n + lx) n) (low (summin * 2 ^ n + lx) n)])› in_set_conv_nth)
thus " ∄y. both_member_options t y"
using "111" ‹∄y. both_member_options (vebt_delete summary (high (summin * 2 ^ n + lx) n)) y› by blast
qed
then show ?thesis by blast
next
case False
then obtain maxs where "Some maxs = ?maxs"
by fastforce
hence "both_member_options summary maxs"
by (metis "1" dele_bmo_cont_corr maxbmo)
have bb:"maxs ≠ ?h ∧ maxs < 2^m"
by (metis "1" ‹Some maxs = vebt_maxt ?sn› dele_bmo_cont_corr maxbmo member_bound valid_member_both_member_options)
hence "invar_vebt (?newlist ! maxs) n"using 0
by (simp add: "2" allvalidinlist)
hence "∃ y. both_member_options (?newlist ! maxs) y"
using "4" bb ‹both_member_options summary maxs› nothprolist by presburger
then obtain maxi where "Some maxi = vebt_maxt (?newlist ! maxs)"
using ‹invar_vebt (treeList [high (summin * 2 ^ n + lx) n := vebt_delete (treeList ! high (summin * 2 ^ n + lx) n) (low (summin * 2 ^ n + lx) n)] ! maxs) n› maxt_corr_help_empty set_vebt'_def valid_member_both_member_options by fastforce
hence "maxs = high ?xn n ∧ both_member_options (?newlist ! maxs) (low ?xn n)"
by (smt (z3) "9" False True ‹Some maxs = vebt_maxt (vebt_delete summary ?h)› ‹invar_vebt (?newlist ! maxs) n› aampt option.sel high_inv low_inv maxbmo maxt_member member_bound mult.commute)
hence False
using bb by blast
then show ?thesis by simp
qed
next
case False
hence "?xn ≠ ?newma" by simp
hence False using aampt by simp
then show ?thesis by blast
qed
qed
have 114: "?newma < 2^deg ∧ ?xn ≤ ?newma"
proof(cases "?xn = ma")
case True
hence "?xn = ma" by simp
let ?maxs = "vebt_maxt ?sn"
show ?thesis
proof(cases "?maxs = None")
case True
then show ?thesis
using "4.hyps"(8) ‹?xn = ma› by force
next
case False
then obtain maxs where "Some maxs = ?maxs"
by fastforce
hence "both_member_options summary maxs"
by (metis "1" dele_bmo_cont_corr maxbmo)
have bb:"maxs ≠ ?h ∧ maxs < 2^m"
by (metis "1" ‹Some maxs = vebt_maxt ?sn› dele_bmo_cont_corr maxbmo member_bound valid_member_both_member_options)
hence "invar_vebt (?newlist ! maxs) n"using 0 by (simp add: "2" allvalidinlist)
hence "∃ y. both_member_options (?newlist ! maxs) y"
using "4" ‹both_member_options summary maxs› bb nothprolist by presburger
then obtain maxi where "Some maxi = vebt_maxt (?newlist ! maxs)"
using ‹invar_vebt (treeList [high (summin * 2 ^ n + lx) n := vebt_delete (treeList ! high (summin * 2 ^ n + lx) n) (low (summin * 2 ^ n + lx) n)] ! maxs) n› empty_Collect_eq maxt_corr_help_empty not_Some_eq set_vebt'_def valid_member_both_member_options by fastforce
hence abc:"?newma = 2^n * maxs + maxi"
by (smt (z3) "9" True ‹Some maxs = vebt_maxt (vebt_delete summary (high (summin * 2 ^ n + lx) n))› option.sel not_None_eq)
have abd:"maxi < 2^n"
by (metis ‹Some maxi = vebt_maxt (?newlist ! maxs)› ‹invar_vebt (?newlist ! maxs) n› maxt_member member_bound)
have "high ?xn n ≤ maxs"
using "1" ‹Some summin = vebt_mint summary› ‹both_member_options summary maxs› ‹vebt_member (treeList ! summin) lx› ‹invar_vebt (treeList ! summin) n› high_inv member_bound mint_corr_help valid_member_both_member_options by force
then show ?thesis
proof(cases "high ?xn n = maxs")
case True
then show ?thesis
using bb by fastforce
next
case False
hence "high ?xn n < maxs"
by (simp add: ‹high (summin * 2 ^ n + lx) n ≤ maxs› order.not_eq_order_implies_strict)
hence "?newma < 2^deg"using
"1" "10" "9" True ‹both_member_options summary maxs› ‹mi ≠ ma ∧ x < 2 ^ deg›
equals0D leD maxt_corr_help maxt_corr_help_empty mem_Collect_eq summaxma set_vebt'_def
valid_member_both_member_options
by (metis option.exhaust_sel)
moreover have "high ?xn n < high ?newma n"
by (smt (z3) "9" True ‹Some maxi = vebt_maxt (treeList [high (summin * 2 ^ n + lx) n := vebt_delete (treeList ! high (summin * 2 ^ n + lx) n) (low (summin * 2 ^ n + lx) n)] ! maxs)› ‹Some maxs = vebt_maxt (vebt_delete summary (high (summin * 2 ^ n + lx) n))› ‹high (summin * 2 ^ n + lx) n < maxs› abd option.sel high_inv mult.commute option.discI)
ultimately show ?thesis
by (metis div_le_mono high_def linear not_less)
qed
qed
next
case False
then show ?thesis
by (smt (z3) "12" "4.hyps"(7) "4.hyps"(8) "9" both_member_options_from_complete_tree_to_child dual_order.trans hlbound one_le_numeral xnin yhelper)
qed
have 115: "?xn ≠ ?newma ⟶
(∀ i < 2^m.
(high ?newma n = i ⟶ both_member_options (?newlist ! i) (low ?newma n)) ∧
(∀ y. (high y n = i ∧ both_member_options (?newlist ! i) (low y n) ) ⟶ ?xn < y ∧ y ≤ ?newma))"
proof
assume assumption0:"?xn ≠ ?newma"
show " (∀ i < 2^m.
(high ?newma n = i ⟶ both_member_options (?newlist ! i) (low ?newma n)) ∧
(∀ y. (high y n = i ∧ both_member_options (?newlist ! i) (low y n) ) ⟶ ?xn < y ∧ y ≤ ?newma))"
proof
fix i
show "i < 2^m ⟶
(high ?newma n = i ⟶ both_member_options (?newlist ! i) (low ?newma n)) ∧
(∀ y. (high y n = i ∧ both_member_options (?newlist ! i) (low y n) ) ⟶ ?xn < y ∧ y ≤ ?newma)"
proof
assume assumption:"i < 2^m"
show " (high ?newma n = i ⟶ both_member_options (?newlist ! i) (low ?newma n)) ∧
(∀ y. (high y n = i ∧ both_member_options (?newlist ! i) (low y n) ) ⟶ ?xn < y ∧ y ≤ ?newma)"
proof-
have "(high ?newma n = i ⟶ both_member_options (?newlist ! i) (low ?newma n))"
proof
assume newmaassm: "high ?newma n = i"
thus " both_member_options (?newlist ! i) (low ?newma n)"
proof(cases "?xn = ma" )
case True
hence bb:"?xn = ma" by simp
let ?maxs = "vebt_maxt ?sn"
show ?thesis
proof(cases "?maxs = None")
case True
hence "?newma = ?xn" using assumption Let_def bb by simp
hence False using assumption0 by simp
then show ?thesis by simp
next
case False
then obtain maxs where "Some maxs = ?maxs"
by fastforce
hence "both_member_options summary maxs"
by (metis "1" dele_bmo_cont_corr maxbmo)
have bb:"maxs ≠ ?h ∧ maxs < 2^m"
by (metis "1" ‹Some maxs = vebt_maxt ?sn› dele_bmo_cont_corr maxbmo member_bound valid_member_both_member_options)
hence "invar_vebt (?newlist ! maxs) n"using 0 by (simp add: "2" allvalidinlist)
hence "∃ y. both_member_options (?newlist ! maxs) y"
using "4" ‹both_member_options summary maxs› bb nothprolist by presburger
then obtain maxi where "Some maxi = vebt_maxt (?newlist ! maxs)" using
‹invar_vebt (treeList [high (summin * 2 ^ n + lx) n :=
vebt_delete (treeList ! high (summin * 2 ^ n + lx) n) (low (summin * 2 ^ n + lx) n)] ! maxs) n›
equals0D maxt_corr_help_empty mem_Collect_eq set_vebt'_def
valid_member_both_member_options
by (metis option.collapse)
then show ?thesis using "1" "10" "9" True ‹Some summin = vebt_mint summary›
‹both_member_options summary maxs› ‹vebt_member (treeList ! summin) lx› ‹mi ≠ ma ∧ x < 2 ^ deg›
‹invar_vebt (treeList ! summin) n› bb equals0D high_inv maxt_corr_help maxt_corr_help_empty
mem_Collect_eq member_bound mint_corr_help nat_less_le summaxma set_vebt'_def
valid_member_both_member_options verit_comp_simplify1(3)
by (metis option.collapse)
qed
next
case False
hence ccc:"?newma = ma" by simp
then show ?thesis
proof(cases "?xn = ma")
case True
hence "?xn = ?newma"
using False by blast
hence False
using False by auto
then show ?thesis by simp
next
case False
hence "both_member_options (?newlist ! high ma n) (low ma n)"
by (metis "1" ‹both_member_options (treeList ! high ma n) (low ma n)› ‹vebt_member (treeList ! summin) lx› ‹vebt_member summary (high ma n)› ‹invar_vebt (treeList ! summin) n› bit_split_inv dele_bmo_cont_corr high_inv hprolist member_bound nothprolist)
moreover have "high ma n = i ∧ low ma n = low ?newma n" using ccc newmaassm by simp
ultimately show ?thesis by simp
qed
qed
qed
moreover have " (∀ y. (high y n = i ∧ both_member_options (?newlist ! i) (low y n) ) ⟶ ?xn < y ∧ y ≤ ?newma)"
proof
fix y
show "(high y n = i ∧ both_member_options (?newlist ! i) (low y n) ) ⟶ ?xn < y ∧ y ≤ ?newma"
proof
assume yassm: "(high y n = i ∧ both_member_options (?newlist ! i) (low y n) )"
hence "?xn < y"
proof(cases "i = ?h")
case True
hence "both_member_options (treeList ! i) (low y n)"
using ‹vebt_member (treeList ! summin) lx› ‹invar_vebt (treeList ! summin) n› dele_bmo_cont_corr high_inv hprolist member_bound yassm by auto
then show ?thesis
using True hprolist min_Null_member ninNullc nnvalid valid_member_both_member_options yassm by fastforce
next
case False
hence "i ≤ ?h ⟹ False"
by (metis "1" "111" ‹Some summin = vebt_mint summary› ‹vebt_member (treeList ! summin) lx› ‹invar_vebt (treeList ! summin) n› assumption dele_bmo_cont_corr high_inv le_antisym member_bound mint_corr_help valid_member_both_member_options yassm)
hence "i > ?h"
using leI by blast
then show ?thesis
by (metis div_le_mono high_def not_less yassm)
qed
moreover have "y ≤ ?newma"
proof(cases "?xn = ma")
case True
hence "?xn= ma" by simp
let ?maxs = "vebt_maxt ?sn"
show ?thesis
proof(cases "?maxs = None")
case True
then show ?thesis
using "1" "111" assumption dele_bmo_cont_corr nothprolist yassm yhelper by auto
next
case False
then obtain maxs where "Some maxs = ?maxs"
by fastforce
hence "both_member_options summary maxs"
by (metis "1" dele_bmo_cont_corr maxbmo)
have bb:"maxs ≠ ?h ∧ maxs < 2^m"
by (metis "1" ‹Some maxs = vebt_maxt ?sn› dele_bmo_cont_corr maxbmo member_bound valid_member_both_member_options)
hence "invar_vebt (?newlist ! maxs) n"using 0
by (simp add: "2" allvalidinlist)
hence "∃ y. both_member_options (?newlist ! maxs) y"
using "4" ‹both_member_options summary maxs› bb nothprolist by presburger
then obtain maxi where "Some maxi = vebt_maxt (?newlist ! maxs)"
by (metis True ‹vebt_member (treeList ! summin) lx› ‹invar_vebt (treeList ! summin) n› assumption calculation dele_bmo_cont_corr high_inv hprolist leD member_bound nth_list_update_neq yassm yhelper)
hence "maxs < 2^m ∧ maxi < 2^n"
by (metis ‹invar_vebt (?newlist ! maxs) n› bb maxt_member member_bound)
hence "?newma = 2^n* maxs + maxi"
by (smt (z3) "9" False True ‹Some maxi = vebt_maxt (?newlist ! maxs)› ‹Some maxs = vebt_maxt (vebt_delete summary (high ?xn n))› option.sel)
hence "low ?newma n = maxi ∧ high ?newma n = maxs"
by (simp add: ‹maxs < 2 ^ m ∧ maxi < 2 ^ n› high_inv low_inv mult.commute)
hence "both_member_options (treeList ! (high y n)) (low y n)"
by (metis "1" "111" assumption dele_bmo_cont_corr nothprolist yassm)
hence hleqdraft:"high y n > maxs ⟹ False"
proof-
assume "high y n > maxs"
have "both_member_options summary (high y n)"
using "1" "111" assumption dele_bmo_cont_corr yassm by blast
moreover have "both_member_options ?sn (high y n)"
using "111" assumption yassm by blast
ultimately show False
using True ‹both_member_options (treeList ! high y n) (low y n)› ‹summin * 2 ^ n + lx < y› assumption leD yassm yhelper by blast
qed
hence hleqmaxs: "high y n ≤ maxs" by presburger
then show ?thesis
using ‹both_member_options (treeList ! high y n) (low y n)› assumption calculation dual_order.strict_trans1 yassm yhelper by auto
qed
next
case False
then show ?thesis
by (smt (z3) ‹vebt_member (treeList ! summin) lx› ‹invar_vebt (treeList ! summin) n› assumption dele_bmo_cont_corr high_inv hprolist member_bound nothprolist yassm yhelper)
qed
ultimately show " ?xn < y ∧ y ≤ ?newma" by simp
qed
qed
ultimately show ?thesis by simp
qed
qed
qed
qed
hence 117: "?newma < 2^deg" and 118: "?xn ≤ ?newma" using 114 by auto
have 116: " invar_vebt (Node (Some (?xn, ?newma)) deg ?newlist ?sn) deg"
using invar_vebt.intros(4)[of ?newlist n ?sn m deg ?xn ?newma]
using 3 allvalidinlist newlistlength newsummvalid "4.hyps"(3) 111 112 118 117 115 by fastforce
show ?thesis
using "116" dsimp by presburger
next
case False
hence notemp:"∃ z. both_member_options ?newnode z"
using not_min_Null_member by auto
let ?newma = "(if ?xn = ma then
?h * 2^(deg div 2) + the( vebt_maxt (?newlist ! ?h))
else ma)"
let ?delsimp =" (Node (Some (?xn, ?newma)) deg ?newlist summary)"
have dsimp:"vebt_delete (Node (Some (x, ma)) deg treeList summary) x = ?delsimp"
using del_x_mi_lets_in_not_minNull[of x mi ma deg ?xn ?h summary treeList ?l ?newnode ?newlist]
"12" "2" "9" False dual_order.eq_iff hlbound inrg order.not_eq_order_implies_strict xmi
by (metis ‹summin * 2 ^ n + lx = (if x = mi then the (vebt_mint summary) * 2 ^ (deg div 2) + the (vebt_mint (treeList ! the (vebt_mint summary))) else x)› ‹x ≠ mi ∨ x ≠ ma›)
have 111: "(∀ i < 2^m. (∃ x. both_member_options (?newlist ! i) x) ⟷ ( both_member_options summary i))"
proof
fix i
show " i < 2^m ⟶ ((∃ x. both_member_options (?newlist ! i) x) = ( both_member_options summary i))"
proof
assume "i < 2^m"
show "(∃ x. both_member_options (?newlist ! i) x) = ( both_member_options summary i)"
proof(cases "i = ?h")
case True
hence 1000:"?newlist ! i = ?newnode"
using hprolist by blast
hence 1001:"∃ x. vebt_member (?newlist ! i) x"
using nnvalid notemp valid_member_both_member_options by auto
hence 1002: "∃ x. both_member_options (?newlist ! i) x"
using "1000" notemp by presburger
have 1003: "both_member_options summary i"
using "4" True ‹∃z. both_member_options (treeList ! summin) z› ‹vebt_member (treeList ! summin) lx› ‹summin < 2 ^ m› ‹invar_vebt (treeList ! summin) n› high_inv member_bound by auto
then show ?thesis
using "1002" by blast
next
case False
hence 1000:"?newlist ! i = treeList ! i"
using ‹i < 2 ^ m› nothprolist by blast
then show ?thesis
using "4" ‹i < 2 ^ m› by presburger
qed
qed
qed
have 112:" (?xn = ?newma ⟶ (∀ t ∈ set ?newlist. ∄ x. both_member_options t x))"
proof
assume aampt:"?xn = ?newma"
show "(∀ t ∈ set ?newlist. ∄ y. both_member_options t y)"
proof(cases "?xn = ma")
case True
obtain maxi where " vebt_maxt (?newlist ! ?h) = Some maxi"
by (metis Collect_empty_eq False hprolist maxt_corr_help_empty nnvalid not_None_eq not_min_Null_member set_vebt'_def valid_member_both_member_options)
hence "both_member_options ?newnode maxi"
using hprolist maxbmo by auto
hence "both_member_options (treeList ! ?h) maxi"
using ‹vebt_member (treeList ! summin) lx› ‹invar_vebt (treeList ! summin) n› dele_bmo_cont_corr high_inv member_bound by force
hence False
by (metis "9" ‹both_member_options (vebt_delete (treeList ! high (summin * 2 ^ n + lx) n) (low (summin * 2 ^ n + lx) n)) maxi› ‹vebt_maxt (?newlist ! ?h) = Some maxi› ‹vebt_member (treeList ! summin) lx› ‹invar_vebt (treeList ! summin) n› aampt add_diff_cancel_left' dele_bmo_cont_corr option.sel high_inv low_inv member_bound)
then show ?thesis by blast
next
case False
then show ?thesis
using ‹mi ≠ ma ∧ x < 2 ^ deg› aampt by presburger
qed
qed
have 114: "?newma < 2^deg ∧ ?xn ≤ ?newma"
proof(cases "?xn = ma")
case True
hence "?xn = ma" by simp
obtain maxi where " vebt_maxt (?newlist ! ?h) = Some maxi"
by (metis "111" "2" "4" Collect_empty_eq True ‹both_member_options (treeList ! high ma n) (low ma n)› ‹high (summin * 2 ^ n + lx) n < length treeList› hprolist maxt_corr_help_empty nnvalid not_None_eq set_vebt'_def valid_member_both_member_options)
hence "both_member_options ?newnode maxi"
using hprolist maxbmo by auto
hence "both_member_options (treeList ! ?h) maxi"
using ‹vebt_member (treeList ! summin) lx› ‹invar_vebt (treeList ! summin) n› dele_bmo_cont_corr high_inv member_bound by force
hence "maxi < 2^n"
using ‹both_member_options?newnode maxi› member_bound nnvalid valid_member_both_member_options by blast
show ?thesis
by (smt (verit, ccfv_threshold) "3" "9" Euclidean_Division.div_eq_0_iff True ‹Some lx = vebt_mint (treeList ! summin)› ‹both_member_options (treeList ! high (summin * 2 ^ n + lx) n) maxi› ‹vebt_maxt (?newlist ! high (summin * 2 ^ n + lx) n) = Some maxi› ‹vebt_member (treeList ! summin) lx› ‹invar_vebt (treeList ! summin) n› add.right_neutral add_left_mono div_mult2_eq div_mult_self3 option.sel high_inv hlbound le_0_eq member_bound mint_corr_help power_add power_not_zero rel_simps(28) valid_member_both_member_options)
next
case False
then show ?thesis
using "10" "4.hyps"(8) maxt_corr_help valid_member_both_member_options xnin by force
qed
have 115: "?xn ≠ ?newma ⟶
(∀ i < 2^m.
(high ?newma n = i ⟶ both_member_options (?newlist ! i) (low ?newma n)) ∧
(∀ y. (high y n = i ∧ both_member_options (?newlist ! i) (low y n) ) ⟶ ?xn < y ∧ y ≤ ?newma))"
proof
assume xnmassm:"?xn ≠ ?newma"
show " (∀ i < 2^m.
(high ?newma n = i ⟶ both_member_options (?newlist ! i) (low ?newma n)) ∧
(∀ y. (high y n = i ∧ both_member_options (?newlist ! i) (low y n) ) ⟶ ?xn < y ∧ y ≤ ?newma))"
proof
fix i
show "i < 2^m ⟶
(high ?newma n = i ⟶ both_member_options (?newlist ! i) (low ?newma n)) ∧
(∀ y. (high y n = i ∧ both_member_options (?newlist ! i) (low y n) ) ⟶ ?xn < y ∧ y ≤ ?newma)"
proof
assume assumption:"i < 2^m"
show " (high ?newma n = i ⟶ both_member_options (?newlist ! i) (low ?newma n)) ∧
(∀ y. (high y n = i ∧ both_member_options (?newlist ! i) (low y n) ) ⟶ ?xn < y ∧ y ≤ ?newma)"
proof-
have "(high ?newma n = i ⟶ both_member_options (?newlist ! i) (low ?newma n))"
proof
assume newmaassm: "high ?newma n = i"
thus " both_member_options (?newlist ! i) (low ?newma n)"
proof(cases "?xn = ma")
case True
obtain maxi where "vebt_maxt (?newlist ! ?h) = Some maxi"
by (metis Collect_empty_eq both_member_options_equiv_member hprolist maxt_corr_help_empty nnvalid not_Some_eq notemp set_vebt'_def)
hence "both_member_options (?newlist ! ?h) maxi"
using maxbmo by blast
then show ?thesis
by (smt (z3) "2" "9" True ‹Some lx = vebt_mint (treeList ! summin)› ‹high (summin * 2 ^ n + lx) n < length treeList› ‹vebt_member (treeList ! summin) lx› ‹invar_vebt (treeList ! summin) n› add_left_mono dele_bmo_cont_corr eq_iff high_inv hprolist low_inv member_bound mint_corr_help valid_member_both_member_options yhelper)
next
case False
hence abcd:"?newma = ma" by simp
then show ?thesis
proof(cases "high ma n = ?h")
case True
hence "?newlist ! high ma n = ?newnode"
using hprolist by presburger
then show ?thesis
by (smt (z3) False True ‹both_member_options (treeList ! high ma n) (low ma n)› ‹vebt_member (treeList ! summin) lx› ‹invar_vebt (treeList ! summin) n› bit_split_inv dele_bmo_cont_corr high_inv member_bound newmaassm)
next
case False
hence "?newlist ! high ma n = treeList ! high ma n"
using "1" ‹vebt_member summary (high ma n)› member_bound nothprolist by blast
moreover hence "both_member_options (treeList ! high ma n) (low ma n)"
using ‹both_member_options (treeList ! high ma n) (low ma n)› by blast
ultimately show ?thesis using abcd newmaassm by simp
qed
qed
qed
moreover have " (∀ y. (high y n = i ∧ both_member_options (?newlist ! i) (low y n) ) ⟶ ?xn < y ∧ y ≤ ?newma)"
proof
fix y
show "(high y n = i ∧ both_member_options (?newlist ! i) (low y n) ) ⟶ ?xn < y ∧ y ≤ ?newma"
proof
assume yassm: "(high y n = i ∧ both_member_options (?newlist ! i) (low y n) )"
hence "?xn < y"
proof(cases "i = ?h")
case True
hence "both_member_options (treeList ! i) (low y n)"
using ‹vebt_member (treeList ! summin) lx› ‹invar_vebt (treeList ! summin) n› dele_bmo_cont_corr high_inv hprolist member_bound yassm by force
moreover have "vebt_mint (treeList ! i) = Some (low ?xn n)"
using True ‹Some lx = vebt_mint (treeList ! summin)› ‹vebt_member (treeList ! summin) lx› ‹invar_vebt (treeList ! summin) n› high_inv low_inv member_bound by presburger
moreover hence "low y n ≥ low ?xn n"
using True ‹vebt_member (treeList ! summin) lx› ‹invar_vebt (treeList ! summin) n› calculation(1) high_inv member_bound mint_corr_help valid_member_both_member_options by auto
moreover have "low y n ≠ low ?xn n"
using True ‹vebt_member (treeList ! summin) lx› ‹invar_vebt (treeList ! summin) n› dele_bmo_cont_corr high_inv hprolist member_bound yassm by auto
ultimately have "low y n > low ?xn n" by simp
show ?thesis
by (metis True ‹low (summin * 2 ^ n + lx) n ≤ low y n› ‹low y n ≠ low (summin * 2 ^ n + lx) n› bit_concat_def bit_split_inv leD linorder_neqE_nat nat_add_left_cancel_less yassm)
next
case False
have "Some (high ?xn n) = vebt_mint summary"
using ‹Some summin = vebt_mint summary› ‹vebt_member (treeList ! summin) lx› ‹invar_vebt (treeList ! summin) n› high_inv member_bound by presburger
moreover hence "high y n ≥ high ?xn n"
by (metis "1" "111" assumption mint_corr_help valid_member_both_member_options yassm)
ultimately show ?thesis
by (metis False div_le_mono high_def leI le_antisym yassm)
qed
moreover have "y ≤ ?newma"
by (smt (z3) ‹vebt_member (treeList ! summin) lx› ‹invar_vebt (treeList ! summin) n› assumption calculation dele_bmo_cont_corr high_inv hprolist leD member_bound nothprolist yassm yhelper)
ultimately show " ?xn < y ∧ y ≤ ?newma" by simp
qed
qed
ultimately show ?thesis by simp
qed
qed
qed
qed
hence 117: "?newma < 2^deg" and 118: "?xn ≤ ?newma" using 114 by auto
have 116: " invar_vebt (Node (Some (?xn, ?newma)) deg ?newlist summary) deg"
using invar_vebt.intros(4)[of ?newlist n summary m deg ?xn ?newma] allvalidinlist
1 newlistlength 8 3 111 112 117 118 115 by fastforce
hence "invar_vebt (?delsimp) deg" by simp
moreover obtain delsimp where 118:"delsimp = ?delsimp" by simp
ultimately have 119:"invar_vebt delsimp deg" by simp
have "vebt_delete (Node (Some (x, ma)) deg treeList summary) x = delsimp" using dsimp 118 by simp
hence "delsimp = vebt_delete (Node (Some (x, ma)) deg treeList summary) x" by simp
then show ?thesis using 119
using xmi by auto
qed
qed
qed
qed
next
case (5 treeList n summary m deg mi ma)
hence 0: "( ∀ t ∈ set treeList. invar_vebt t n)" and 1: " invar_vebt summary m" and 2:"length treeList = 2^m" and 3:" deg = n+m" and
4: "(∀ i < 2^m. (∃ y. both_member_options (treeList ! i) y) ⟷ ( both_member_options summary i))" and
5: "(mi = ma ⟶ (∀ t ∈ set treeList. ∄ y. both_member_options t y))" and 6:"mi ≤ ma ∧ ma < 2^deg" and
7: "(mi ≠ ma ⟶ (∀ i < 2^m. (high ma n = i ⟶ both_member_options (treeList ! i) (low ma n)) ∧
(∀ y. (high y n = i ∧ both_member_options (treeList ! i) (low y n) ) ⟶ mi < y ∧ y ≤ ma)))"
and 8: "Suc n = m" and 9: "deg div 2 = n" using "5" add_self_div_2 by auto
hence 10: "invar_vebt (Node (Some (mi, ma)) deg treeList summary) deg"
using invar_vebt.intros(5)[of treeList n summary m deg mi ma] by blast
hence 11:"n ≥ 1 " and 12: " deg ≥ 2"
by (metis "0" "2" "9" One_nat_def deg_not_0 div_greater_zero_iff le_0_eq numeral_2_eq_2 set_n_deg_not_0)+
then show ?case
proof(cases "(x < mi ∨ x > ma)")
case True
hence "vebt_delete (Node (Some (mi, ma)) deg treeList summary) x = (Node (Some (mi, ma)) deg treeList summary)"
using delt_out_of_range[of x mi ma deg treeList summary]
using "12" by fastforce
then show ?thesis
by (simp add: "10")
next
case False
hence inrg: "mi≤ x ∧ x ≤ ma" by simp
then show ?thesis
proof(cases "x = mi ∧ x = ma")
case True
hence" (∀ t ∈ set treeList. ∄ y. both_member_options t y)"
using "5" by blast
moreover have "vebt_delete (Node (Some (mi, ma)) deg treeList summary) x = (Node None deg treeList summary)"
using del_single_cont[of x mi ma deg treeList summary] "1" "8" "9" True deg_not_0 div_greater_zero_iff "12" by fastforce
moreover have " (∄ i. both_member_options summary i)"
using "10" True mi_eq_ma_no_ch by blast
ultimately show ?thesis
using "0" "1" "2" "3" "8" invar_vebt.intros(3) by force
next
case False
hence "x ≠ mi ∨ x ≠ ma" by simp
hence "mi ≠ ma ∧ x < 2^deg"
by (metis "6" inrg le_antisym le_less_trans)
hence "7b": "(∀ i < 2^m. (high ma n = i ⟶ both_member_options (treeList ! i) (low ma n)) ∧
(∀ y. (high y n = i ∧ both_member_options (treeList ! i) (low y n) ) ⟶ mi < y ∧ y ≤ ma))"
using "7" by fastforce
hence "both_member_options (treeList ! (high ma n)) (low ma n)"
by (metis "1" "12" "3" "6" "9" deg_not_0 div_greater_zero_iff exp_split_high_low(1) zero_less_numeral)
hence yhelper:"both_member_options (treeList ! (high y n)) (low y n)
⟹ high y n < 2^m ⟹ mi < y ∧ y ≤ ma ∧ low y n < 2^n" for y
by (simp add: "7b" low_def)
then show ?thesis
proof(cases "x ≠ mi")
case True
hence xnotmi: "x ≠ mi" by simp
let ?h = "high x n"
let ?l = "low x n"
have hlbound:"?h < 2^m ∧ ?l < 2^n"
by (metis "1" "11" "3" One_nat_def ‹mi ≠ ma ∧ x < 2 ^ deg› deg_not_0 dual_order.strict_trans1 exp_split_high_low(1) exp_split_high_low(2) zero_less_Suc)
let ?newnode = "vebt_delete (treeList ! ?h) ?l"
have "treeList ! ?h ∈ set treeList "
by (metis "2" hlbound in_set_member inthall)
hence nnvalid: "invar_vebt ?newnode n"
by (simp add: "5.IH"(1))
let ?newlist = "treeList[?h:= ?newnode]"
have hlist:"?newlist ! ?h = ?newnode"
by (simp add: "2" hlbound)
have nothlist:"i ≠ ?h ⟹ i < 2^m ⟹ ?newlist ! i = treeList ! i" for i by simp
have allvalidinlist:"∀ t ∈ set ?newlist. invar_vebt t n"
proof
fix t
assume "t ∈ set ?newlist"
then obtain i where "i< 2^m ∧ ?newlist ! i = t"
by (metis "2" in_set_conv_nth length_list_update)
then show "invar_vebt t n"
by (metis "0" "2" hlist nnvalid nth_list_update_neq nth_mem)
qed
have newlistlength: "length ?newlist = 2^m"
by (simp add: "2")
then show ?thesis
proof(cases "minNull ?newnode")
case True
hence ninNullc: "minNull ?newnode" by simp
let ?sn = "vebt_delete summary ?h"
let ?newma= "(if x = ma then (let maxs = vebt_maxt ?sn in
(if maxs = None
then mi
else 2^(deg div 2) * the maxs
+ the (vebt_maxt (?newlist ! the maxs))
)
)
else ma)"
let ?delsimp =" (Node (Some (mi, ?newma)) deg ?newlist ?sn)"
have dsimp:"vebt_delete (Node (Some (mi, ma)) deg treeList summary) x = ?delsimp"
using del_x_not_mi_new_node_nil[of mi x ma deg ?h ?l ?newnode treeList ?sn summary ?newlist]
hlbound 9 11 12 True 2 inrg xnotmi by simp
have newsummvalid: "invar_vebt ?sn m"
by (simp add: "5.IH"(2))
have 111: "(∀ i < 2^m. (∃ x. both_member_options (?newlist ! i) x) ⟷ ( both_member_options ?sn i))"
proof
fix i
show " i < 2^m ⟶ ((∃ x. both_member_options (?newlist ! i) x) = ( both_member_options ?sn i))"
proof
assume "i < 2^m"
show "(∃ x. both_member_options (?newlist ! i) x) = ( both_member_options ?sn i)"
proof(cases "i = ?h")
case True
hence 1000:"?newlist ! i = ?newnode"
using hlist by blast
hence 1001:"∄ x. vebt_member (?newlist ! i) x"
by (simp add: min_Null_member ninNullc)
hence 1002: "∄ x. both_member_options (?newlist ! i) x"
using "1000" nnvalid valid_member_both_member_options by auto
have 1003: "¬ both_member_options ?sn i"
using "1" True dele_bmo_cont_corr by auto
then show ?thesis
using "1002" by blast
next
case False
hence 1000:"?newlist ! i = treeList ! i"
using ‹i < 2 ^ m› nothlist by blast
hence "both_member_options (?newlist ! i) y ⟹ both_member_options ?sn i" for y
by (metis "1" "4" False ‹i < 2 ^ m› dele_bmo_cont_corr)
moreover have "both_member_options ?sn i ⟹ ∃ y. both_member_options (?newlist ! i) y"
using "1" "4" ‹i < 2 ^ m› dele_bmo_cont_corr by force
then show ?thesis
using calculation by blast
qed
qed
qed
have 112:" (mi = ?newma ⟶ (∀ t ∈ set ?newlist. ∄ x. both_member_options t x))"
proof
assume aampt:"mi = ?newma"
show "(∀ t ∈ set ?newlist. ∄ y. both_member_options t y)"
proof(cases "x = ma")
case True
let ?maxs = "vebt_maxt ?sn"
show ?thesis
proof(cases "?maxs = None")
case True
hence aa:"∄ y. vebt_member ?sn y"
using maxt_corr_help_empty newsummvalid set_vebt'_def by auto
hence "∄ y. both_member_options ?sn y"
using newsummvalid valid_member_both_member_options by blast
hence "t ∈ set ?newlist ⟹ ∄y. both_member_options t y" for t
proof-
assume "t ∈ set ?newlist"
then obtain i where "?newlist ! i = t ∧ i< 2^m"
by (metis in_set_conv_nth newlistlength)
thus " ∄y. both_member_options t y"
using "111" ‹∄y. both_member_options (vebt_delete summary (high x n)) y› by blast
qed
then show ?thesis by blast
next
case False
then obtain maxs where "Some maxs = ?maxs"
by fastforce
hence "both_member_options summary maxs"
by (metis "1" dele_bmo_cont_corr maxbmo)
have bb:"maxs ≠ ?h ∧ maxs < 2^m"
by (metis "1" ‹Some maxs = vebt_maxt ?sn› dele_bmo_cont_corr maxbmo member_bound valid_member_both_member_options)
hence "invar_vebt (?newlist ! maxs) n"using 0
by (metis allvalidinlist newlistlength nth_mem)
hence "∃ y. both_member_options (?newlist ! maxs) y"
using "4" bb ‹both_member_options summary maxs› nothlist by presburger
then obtain maxi where "Some maxi = vebt_maxt (?newlist ! maxs)"
by (metis Collect_empty_eq_bot ‹invar_vebt (treeList[high x n := vebt_delete (treeList ! high x n) (low x n)] ! maxs) n› bb bot_empty_eq equals0D maxt_corr_help_empty nth_list_update_neq option_shift.elims set_vebt'_def valid_member_both_member_options)
hence "maxs = high mi n ∧ both_member_options (?newlist ! maxs) (low mi n)"
by (smt (z3) "9" False True ‹Some maxs = vebt_maxt (vebt_delete summary (high x n))› ‹invar_vebt (?newlist ! maxs) n› aampt option.sel high_inv low_inv maxbmo maxt_member member_bound mult.commute)
hence False
by (metis bb nat_less_le nothlist yhelper)
then show ?thesis by simp
qed
next
case False
then show ?thesis
using ‹mi ≠ ma ∧ x < 2 ^ deg› aampt by presburger
qed
qed
have 114: "?newma < 2^deg ∧ mi ≤ ?newma"
proof(cases "x = ma")
case True
hence "x = ma" by simp
let ?maxs = "vebt_maxt ?sn"
show ?thesis
proof(cases "?maxs = None")
case True
then show ?thesis
using "6" by fastforce
next
case False
then obtain maxs where "Some maxs = ?maxs"
by fastforce
hence "both_member_options summary maxs"
by (metis "1" dele_bmo_cont_corr maxbmo)
have bb:"maxs ≠ ?h ∧ maxs < 2^m"
by (metis "1" ‹Some maxs = vebt_maxt ?sn› dele_bmo_cont_corr maxbmo member_bound valid_member_both_member_options)
hence "invar_vebt (?newlist ! maxs) n"using 0
by (metis allvalidinlist newlistlength nth_mem)
hence "∃ y. both_member_options (?newlist ! maxs) y"
using "4" bb ‹both_member_options summary maxs› nothlist by presburger
then obtain maxi where "Some maxi = vebt_maxt (?newlist ! maxs)"
by (smt (z3) VEBT_Member.vebt_member.simps(2) ‹invar_vebt (?newlist ! maxs) n› vebt_maxt.elims minNull.simps(1) min_Null_member valid_member_both_member_options)
then show ?thesis
by (smt (verit, best) "6" "9" ‹Some maxs = vebt_maxt (vebt_delete summary (high x n))› ‹invar_vebt (?newlist ! maxs) n› bb option.sel high_inv less_le_trans low_inv maxbmo maxt_member member_bound mult.commute not_less_iff_gr_or_eq nothlist verit_comp_simplify1(3) yhelper)
qed
next
case False
then show ?thesis
using "6" by auto
qed
have 115: "mi ≠ ?newma ⟶
(∀ i < 2^m.
(high ?newma n = i ⟶ both_member_options (?newlist ! i) (low ?newma n)) ∧
(∀ y. (high y n = i ∧ both_member_options (?newlist ! i) (low y n) ) ⟶ mi < y ∧ y ≤ ?newma))"
proof
assume "mi ≠ ?newma"
show " (∀ i < 2^m.
(high ?newma n = i ⟶ both_member_options (?newlist ! i) (low ?newma n)) ∧
(∀ y. (high y n = i ∧ both_member_options (?newlist ! i) (low y n) ) ⟶ mi < y ∧ y ≤ ?newma))"
proof
fix i
show "i < 2^m ⟶
(high ?newma n = i ⟶ both_member_options (?newlist ! i) (low ?newma n)) ∧
(∀ y. (high y n = i ∧ both_member_options (?newlist ! i) (low y n) ) ⟶ mi < y ∧ y ≤ ?newma)"
proof
assume assumption:"i < 2^m"
show " (high ?newma n = i ⟶ both_member_options (?newlist ! i) (low ?newma n)) ∧
(∀ y. (high y n = i ∧ both_member_options (?newlist ! i) (low y n) ) ⟶ mi < y ∧ y ≤ ?newma)"
proof-
have "(high ?newma n = i ⟶ both_member_options (?newlist ! i) (low ?newma n))"
proof
assume newmaassm: "high ?newma n = i"
thus " both_member_options (?newlist ! i) (low ?newma n)"
proof(cases "x = ma" )
case True
let ?maxs = "vebt_maxt ?sn"
show ?thesis
proof(cases "?maxs = None")
case True
then show ?thesis
by (smt (z3) "0" ‹both_member_options (treeList ! high ma n) (low ma n)› ‹mi ≠ (if x = ma then let maxs = vebt_maxt (vebt_delete summary (high x n)) in if maxs = None then mi else 2 ^ (deg div 2) * the maxs + the (vebt_maxt (?newlist ! the maxs)) else ma)› ‹treeList ! high x n ∈ set treeList› assumption bit_split_inv dele_bmo_cont_corr hlist newmaassm nothlist)
next
case False
then obtain maxs where "Some maxs = ?maxs"
by fastforce
hence "both_member_options summary maxs"
by (metis "1" dele_bmo_cont_corr maxbmo)
have bb:"maxs ≠ ?h ∧ maxs < 2^m"
by (metis "1" ‹Some maxs = vebt_maxt ?sn› dele_bmo_cont_corr maxbmo member_bound valid_member_both_member_options)
hence "invar_vebt (?newlist ! maxs) n"using 0 "2" by auto
hence "∃ y. both_member_options (?newlist ! maxs) y"
using "4" bb ‹both_member_options summary maxs› nothlist by presburger
then obtain maxi where "Some maxi = vebt_maxt (?newlist ! maxs)"
by (smt (z3) VEBT_Member.vebt_member.simps(2) ‹invar_vebt (treeList[high x n := vebt_delete (treeList ! high x n) (low x n)] ! maxs) n› vebt_maxt.elims minNull.simps(1) min_Null_member valid_member_both_member_options)
then show ?thesis
by (smt (z3) "9" True ‹Some maxs = vebt_maxt (vebt_delete summary (high x n))› ‹invar_vebt (treeList[high x n := vebt_delete (treeList ! high x n) (low x n)] ! maxs) n› option.sel high_inv low_inv maxbmo maxt_member member_bound mult.commute newmaassm option.distinct(1))
qed
next
case False
then show ?thesis
by (smt (z3) "0" ‹both_member_options (treeList ! high ma n) (low ma n)› ‹treeList ! high x n ∈ set treeList› assumption bit_split_inv dele_bmo_cont_corr hlist newmaassm nothlist)
qed
qed
moreover have " (∀ y. (high y n = i ∧ both_member_options (?newlist ! i) (low y n) ) ⟶ mi < y ∧ y ≤ ?newma)"
proof
fix y
show "(high y n = i ∧ both_member_options (?newlist ! i) (low y n) ) ⟶ mi < y ∧ y ≤ ?newma"
proof
assume yassm: "(high y n = i ∧ both_member_options (?newlist ! i) (low y n) )"
hence "mi < y"
proof(cases "i = ?h")
case True
hence "both_member_options (treeList ! i) (low y n)"
using "0" ‹treeList ! high x n ∈ set treeList› dele_bmo_cont_corr hlist yassm by auto
then show ?thesis
by (simp add: assumption yassm yhelper)
next
case False
then show ?thesis
using assumption nothlist yassm yhelper by presburger
qed
moreover have "y ≤ ?newma"
proof(cases "x = ma")
case True
hence "x= ma" by simp
let ?maxs = "vebt_maxt ?sn"
show ?thesis
proof(cases "?maxs = None")
case True
then show ?thesis
using ‹mi ≠ ?newma› ‹x = ma› by presburger
next
case False
then obtain maxs where "Some maxs = ?maxs"
by fastforce
hence "both_member_options summary maxs"
by (metis "1" dele_bmo_cont_corr maxbmo)
have bb:"maxs ≠ ?h ∧ maxs < 2^m"
by (metis "1" ‹Some maxs = vebt_maxt ?sn› dele_bmo_cont_corr maxbmo member_bound valid_member_both_member_options)
hence "invar_vebt (?newlist ! maxs) n"using 0 "2" by fastforce
hence "∃ y. both_member_options (?newlist ! maxs) y"
using "4" bb ‹both_member_options summary maxs› nothlist by presburger
then obtain maxi where "Some maxi = vebt_maxt (?newlist ! maxs)"
by (metis ‹invar_vebt (treeList[high x n := vebt_delete (treeList ! high x n) (low x n)] ! maxs) n› equals0D maxt_corr_help_empty mem_Collect_eq option_shift.elims set_vebt'_def valid_member_both_member_options)
hence "maxs < 2^m ∧ maxi < 2^n"
by (metis ‹invar_vebt (?newlist ! maxs) n› bb maxt_member member_bound)
hence "?newma = 2^n* maxs + maxi"
by (smt (z3) "9" False True ‹Some maxi = vebt_maxt (?newlist ! maxs)› ‹Some maxs = vebt_maxt (vebt_delete summary (high x n))› option.sel)
hence "low ?newma n = maxi ∧ high ?newma n = maxs"
by (simp add: ‹maxs < 2 ^ m ∧ maxi < 2 ^ n› high_inv low_inv mult.commute)
hence "both_member_options (treeList ! (high y n)) (low y n)"
by (metis "0" ‹treeList ! high x n ∈ set treeList› assumption dele_bmo_cont_corr hlist nothlist yassm)
hence hleqdraft:"high y n > maxs ⟹ False"
proof-
assume "high y n > maxs"
have "both_member_options summary (high y n)"
using "1" "111" assumption dele_bmo_cont_corr yassm by blast
moreover have "both_member_options ?sn (high y n)"
using "111" assumption yassm by blast
ultimately show False
by (metis ‹Some maxs = vebt_maxt (vebt_delete summary (high x n))› ‹maxs < high y n› leD maxt_corr_help newsummvalid valid_member_both_member_options)
qed
hence hleqmaxs: "high y n ≤ maxs" by presburger
then show ?thesis
proof(cases "high y n = maxs")
case True
hence "low y n ≤ maxi"
by (metis ‹Some maxi = vebt_maxt (treeList[high x n := vebt_delete (treeList ! high x n) (low x n)] ! maxs)› ‹invar_vebt (treeList[high x n := vebt_delete (treeList ! high x n) (low x n)] ! maxs) n› maxt_corr_help valid_member_both_member_options yassm)
then show ?thesis
by (smt (z3) True ‹(if x = ma then let maxs = vebt_maxt (vebt_delete summary (high x n)) in if maxs = None then mi else 2 ^ (deg div 2) * the maxs + the (vebt_maxt (treeList [high x n := vebt_delete (treeList ! high x n) (low x n)] ! the maxs)) else ma) = 2 ^ n * maxs + maxi› add_le_cancel_left bit_concat_def bit_split_inv mult.commute)
next
case False
then show ?thesis
by (smt (z3) ‹low (if x = ma then let maxs = vebt_maxt (vebt_delete summary (high x n)) in if maxs = None then mi else 2 ^ (deg div 2) * the maxs + the (vebt_maxt (treeList [high x n := vebt_delete (treeList ! high x n) (low x n)] ! the maxs)) else ma) n = maxi ∧ high (if x = ma then let maxs = vebt_maxt (vebt_delete summary (high x n)) in if maxs = None then mi else 2 ^ (deg div 2) * the maxs + the (vebt_maxt (treeList [high x n := vebt_delete (treeList ! high x n) (low x n)] ! the maxs)) else ma) n = maxs› div_le_mono high_def hleqmaxs le_antisym nat_le_linear)
qed
qed
next
case False
then show ?thesis
by (smt (z3) "0" ‹treeList ! high x n ∈ set treeList› assumption dele_bmo_cont_corr hlist nothlist yassm yhelper)
qed
ultimately show " mi < y ∧ y ≤ ?newma" by simp
qed
qed
ultimately show ?thesis by simp
qed
qed
qed
qed
hence 117: "?newma < 2^deg" and 118: "mi ≤ ?newma" using 114 by auto
have 116: " invar_vebt (Node (Some (mi, ?newma)) deg ?newlist ?sn) deg"
using invar_vebt.intros(5)[of ?newlist n ?sn m deg mi ?newma]
using 3 allvalidinlist newlistlength newsummvalid "5.hyps"(3) 111 112 118 117 115 by fastforce
show ?thesis
using "116" dsimp by presburger
next
case False
hence notemp:"∃ z. both_member_options ?newnode z"
using not_min_Null_member by auto
let ?newma = "(if x = ma then
?h * 2^(deg div 2) + the( vebt_maxt (?newlist ! ?h))
else ma)"
let ?delsimp =" (Node (Some (mi, ?newma)) deg ?newlist summary)"
have dsimp:"vebt_delete (Node (Some (mi, ma)) deg treeList summary) x = ?delsimp"
using del_x_not_mi_newnode_not_nil[of mi x ma deg ?h ?l ?newnode treeList ?newlist summary]
by (metis "12" "2" "9" False dual_order.eq_iff hlbound inrg order.not_eq_order_implies_strict xnotmi)
have 111: "(∀ i < 2^m. (∃ x. both_member_options (?newlist ! i) x) ⟷ ( both_member_options summary i))"
proof
fix i
show " i < 2^m ⟶ ((∃ x. both_member_options (?newlist ! i) x) = ( both_member_options summary i))"
proof
assume "i < 2^m"
show "(∃ x. both_member_options (?newlist ! i) x) = ( both_member_options summary i)"
proof(cases "i = ?h")
case True
hence 1000:"?newlist ! i = ?newnode"
using hlist by blast
hence 1001:"∃ x. vebt_member (?newlist ! i) x"
using nnvalid notemp valid_member_both_member_options by auto
hence 1002: "∃ x. both_member_options (?newlist ! i) x"
using "1000" notemp by presburger
have 1003: "both_member_options summary i"
using "0" "1000" "1002" "4" True ‹i < 2 ^ m› ‹treeList ! high x n ∈ set treeList› dele_bmo_cont_corr by fastforce
then show ?thesis
using "1002" by blast
next
case False
hence 1000:"?newlist ! i = treeList ! i"
using ‹i < 2 ^ m› nothlist by blast
then show ?thesis
using "4" ‹i < 2 ^ m› by presburger
qed
qed
qed
have 112:" (mi = ?newma ⟶ (∀ t ∈ set ?newlist. ∄ x. both_member_options t x))"
proof
assume aampt:"mi = ?newma"
show "(∀ t ∈ set ?newlist. ∄ y. both_member_options t y)"
proof(cases "x = ma")
case True
obtain maxi where " vebt_maxt (?newlist ! ?h) = Some maxi"
by (metis False VEBT_Member.vebt_member.simps(2) hlist vebt_maxt.elims minNull.simps(1) nnvalid notemp valid_member_both_member_options)
hence "both_member_options ?newnode maxi"
using hlist maxbmo by auto
hence "both_member_options (treeList ! ?h) maxi"
using "0" ‹treeList ! high x n ∈ set treeList› dele_bmo_cont_corr by blast
hence False
by (metis "9" True ‹both_member_options ?newnode maxi› ‹vebt_maxt ( ?newlist ! high x n) = Some maxi› aampt option.sel high_inv hlbound low_inv member_bound nnvalid not_less_iff_gr_or_eq valid_member_both_member_options yhelper)
then show ?thesis by blast
next
case False
then show ?thesis
using ‹mi ≠ ma ∧ x < 2 ^ deg› aampt by presburger
qed
qed
have 114: "?newma < 2^deg ∧ mi ≤ ?newma"
proof(cases "x = ma")
case True
hence "x = ma" by simp
obtain maxi where " vebt_maxt (?newlist ! ?h) = Some maxi"
by (metis False VEBT_Member.vebt_member.simps(2) hlist vebt_maxt.elims minNull.simps(1) nnvalid notemp valid_member_both_member_options)
hence "both_member_options ?newnode maxi"
using hlist maxbmo by auto
hence "both_member_options (treeList ! ?h) maxi"
using "0" ‹treeList ! high x n ∈ set treeList› dele_bmo_cont_corr by blast
hence "maxi < 2^n"
using ‹both_member_options?newnode maxi› member_bound nnvalid valid_member_both_member_options by blast
show ?thesis
by (smt (z3) "3" "9" Euclidean_Division.div_eq_0_iff True ‹both_member_options (treeList ! high x n) maxi› ‹maxi < 2 ^ n› ‹vebt_maxt ( ?newlist ! high x n) = Some maxi› add.right_neutral div_exp_eq div_mult_self3 option.sel high_inv hlbound le_0_eq less_imp_le_nat low_inv power_not_zero rel_simps(28) yhelper)
next
case False
then show ?thesis
using "6" by auto
qed
have 115: "mi ≠ ?newma ⟶
(∀ i < 2^m.
(high ?newma n = i ⟶ both_member_options (?newlist ! i) (low ?newma n)) ∧
(∀ y. (high y n = i ∧ both_member_options (?newlist ! i) (low y n) ) ⟶ mi < y ∧ y ≤ ?newma))"
proof
assume "mi ≠ ?newma"
show " (∀ i < 2^m.
(high ?newma n = i ⟶ both_member_options (?newlist ! i) (low ?newma n)) ∧
(∀ y. (high y n = i ∧ both_member_options (?newlist ! i) (low y n) ) ⟶ mi < y ∧ y ≤ ?newma))"
proof
fix i
show "i < 2^m ⟶
(high ?newma n = i ⟶ both_member_options (?newlist ! i) (low ?newma n)) ∧
(∀ y. (high y n = i ∧ both_member_options (?newlist ! i) (low y n) ) ⟶ mi < y ∧ y ≤ ?newma)"
proof
assume assumption:"i < 2^m"
show " (high ?newma n = i ⟶ both_member_options (?newlist ! i) (low ?newma n)) ∧
(∀ y. (high y n = i ∧ both_member_options (?newlist ! i) (low y n) ) ⟶ mi < y ∧ y ≤ ?newma)"
proof-
have "(high ?newma n = i ⟶ both_member_options (?newlist ! i) (low ?newma n))"
proof
assume newmaassm: "high ?newma n = i"
thus " both_member_options (?newlist ! i) (low ?newma n)"
proof(cases "x = ma")
case True
obtain maxi where "vebt_maxt (?newlist ! ?h) = Some maxi"
by (metis Collect_empty_eq both_member_options_equiv_member hlist maxt_corr_help_empty nnvalid not_Some_eq notemp set_vebt'_def)
hence "both_member_options (?newlist ! ?h) maxi"
using maxbmo by blast
then show ?thesis
by (smt (z3) "9" True ‹vebt_maxt (?newlist ! high x n) = Some maxi› option.sel high_inv hlist low_inv maxt_member member_bound newmaassm nnvalid)
next
case False
then show ?thesis
by (smt (z3) "0" ‹both_member_options (treeList ! high ma n) (low ma n)› ‹treeList ! high x n ∈ set treeList› assumption bit_split_inv dele_bmo_cont_corr hlist newmaassm nothlist)
qed
qed
moreover have " (∀ y. (high y n = i ∧ both_member_options (?newlist ! i) (low y n) ) ⟶ mi < y ∧ y ≤ ?newma)"
proof
fix y
show "(high y n = i ∧ both_member_options (?newlist ! i) (low y n) ) ⟶ mi < y ∧ y ≤ ?newma"
proof
assume yassm: "(high y n = i ∧ both_member_options (?newlist ! i) (low y n) )"
hence "mi < y"
proof(cases "i = ?h")
case True
hence "both_member_options (treeList ! i) (low y n)"
using "0" ‹treeList ! high x n ∈ set treeList› dele_bmo_cont_corr hlist yassm by auto
then show ?thesis
by (simp add: assumption yassm yhelper)
next
case False
then show ?thesis
using assumption nothlist yassm yhelper by presburger
qed
moreover have "y ≤ ?newma"
proof(cases "x = ma")
case True
hence "x= ma" by simp
obtain maxi where "vebt_maxt (?newlist ! ?h) = Some maxi"
by (metis Collect_empty_eq both_member_options_equiv_member hlist maxt_corr_help_empty nnvalid not_Some_eq notemp set_vebt'_def)
hence "both_member_options (?newlist ! ?h) maxi"
using maxbmo by blast
have "high y n ≤ ?h"
by (metis "7b" True assumption div_le_mono high_def nothlist yassm)
then show ?thesis
proof(cases "high y n = ?h")
case True
have "low y n > maxi ⟹ False"
by (metis True ‹vebt_maxt (?newlist ! ?h) = Some maxi› hlist leD maxt_corr_help nnvalid valid_member_both_member_options yassm)
then show ?thesis
by (smt (z3) "9" True ‹vebt_maxt (?newlist ! ?h) = Some maxi› ‹x = ma› add_le_cancel_left div_mult_mod_eq option.sel high_def low_def nat_le_linear nat_less_le)
next
case False
then show ?thesis
by (smt (z3) "9" True ‹both_member_options (?newlist ! high x n) maxi› ‹high y n ≤ high x n› ‹vebt_maxt (?newlist ! high x n) = Some maxi› div_le_mono option.sel high_def high_inv hlist le_antisym member_bound nat_le_linear nnvalid valid_member_both_member_options)
qed
next
case False
then show ?thesis
by (smt (z3) "0" ‹treeList ! high x n ∈ set treeList› assumption dele_bmo_cont_corr hlist nothlist yassm yhelper)
qed
ultimately show " mi < y ∧ y ≤ ?newma" by simp
qed
qed
ultimately show ?thesis by simp
qed
qed
qed
qed
hence 117: "?newma < 2^deg" and 118: "mi ≤ ?newma" using 114 by auto
have 116: " invar_vebt (Node (Some (mi, ?newma)) deg ?newlist summary) deg"
using invar_vebt.intros(5)[of ?newlist n summary m deg mi ?newma] allvalidinlist
1 newlistlength 8 3 111 112 117 118 115 by fastforce
then show ?thesis
using dsimp by presburger
qed
next
case False
hence xmi:"x = mi" by simp
have "both_member_options summary (high ma n)"
by (metis "1" "11" "3" "4" "6" One_nat_def Suc_le_eq ‹both_member_options (treeList ! high ma n) (low ma n)› deg_not_0 exp_split_high_low(1))
hence "vebt_member summary (high ma n)"
using "5.hyps"(1) valid_member_both_member_options by blast
obtain summin where "Some summin = vebt_mint summary"
by (metis "5.hyps"(1) ‹vebt_member summary (high ma n)› empty_Collect_eq mint_corr_help_empty not_None_eq set_vebt'_def)
hence "∃ z . both_member_options (treeList ! summin) z"
by (metis "5.hyps"(1) "5.hyps"(5) both_member_options_equiv_member member_bound mint_member)
moreover have "invar_vebt (treeList ! summin) n"
by (metis "0" "1" "2" ‹Some summin = vebt_mint summary› member_bound mint_member nth_mem)
ultimately obtain lx where "Some lx = vebt_mint (treeList ! summin)"
by (metis empty_Collect_eq mint_corr_help_empty not_None_eq set_vebt'_def valid_member_both_member_options)
let ?xn = "summin*2^n + lx"
have "?xn = (if x = mi
then the (vebt_mint summary) * 2^(deg div 2)
+ the (vebt_mint (treeList ! the (vebt_mint summary)))
else x)"
by (metis False ‹Some lx = vebt_mint (treeList ! summin)› ‹Some summin = vebt_mint summary› ‹deg div 2 = n› option.sel)
have "vebt_member (treeList ! summin) lx"
using ‹Some lx = vebt_mint (treeList ! summin)› ‹invar_vebt (treeList ! summin) n› mint_member by auto
moreover have "summin < 2^m"
by (metis "5.hyps"(1) ‹Some summin = vebt_mint summary› member_bound mint_member)
ultimately have xnin: "both_member_options (Node (Some (mi, ma)) deg treeList summary) ?xn"
by (metis "12" "2" "9" ‹invar_vebt (treeList ! summin) n› add_leD1 both_member_options_equiv_member both_member_options_from_chilf_to_complete_tree high_inv low_inv member_bound numeral_2_eq_2 plus_1_eq_Suc)
let ?h ="high ?xn n"
let ?l = "low ?xn n"
have "?xn < 2^deg"
by (smt (verit, ccfv_SIG) "5.hyps"(1) "5.hyps"(4) Euclidean_Division.div_eq_0_iff ‹Some lx = vebt_mint (treeList ! summin)› ‹Some summin = vebt_mint summary› ‹invar_vebt (treeList ! summin) n› div_exp_eq high_def high_inv le_0_eq member_bound mint_member not_numeral_le_zero power_not_zero)
hence "?h < length treeList"
using "2" ‹vebt_member (treeList ! summin) lx› ‹summin < 2 ^ m› ‹invar_vebt (treeList ! summin) n› high_inv member_bound by presburger
let ?newnode = "vebt_delete (treeList ! ?h) ?l"
let ?newlist = "treeList[?h:= ?newnode]"
have "length treeList = length ?newlist" by auto
hence hprolist: "?newlist ! ?h = ?newnode"
by (meson ‹high (summin * 2 ^ n + lx) n < length treeList› nth_list_update_eq)
have nothprolist: "i ≠ ?h ∧ i < 2^m ⟹ ?newlist ! i = treeList ! i" for i by auto
have hlbound:"?h < 2^m ∧ ?l < 2^n"
using "2" ‹high (summin * 2 ^ n + lx) n < length treeList› ‹vebt_member (treeList ! summin) lx› ‹invar_vebt (treeList ! summin) n› low_inv member_bound by presburger
hence nnvalid: "invar_vebt ?newnode n"
by (metis "5.IH"(1) ‹high (summin * 2 ^ n + lx) n < length treeList› inthall member_def)
have allvalidinlist:"∀ t ∈ set ?newlist. invar_vebt t n"
proof
fix t
assume "t ∈ set ?newlist"
then obtain i where "i < 2^m ∧ ?newlist ! i = t"
by (metis "2" in_set_conv_nth length_list_update)
then show "invar_vebt t n"
by (metis "0" "2" hprolist nnvalid nth_list_update_neq nth_mem)
qed
have newlistlength: "length ?newlist = 2^m"
by (simp add: "2")
then show ?thesis
proof(cases "minNull ?newnode")
case True
hence ninNullc: "minNull ?newnode" by simp
let ?sn = "vebt_delete summary ?h"
let ?newma= "(if ?xn = ma then (let maxs = vebt_maxt ?sn in
(if maxs = None
then ?xn
else 2^(deg div 2) * the maxs
+ the (vebt_maxt (?newlist ! the maxs))
)
)
else ma)"
let ?delsimp =" (Node (Some (?xn, ?newma)) deg ?newlist ?sn)"
have dsimp:"vebt_delete (Node (Some (mi, ma)) deg treeList summary) x = ?delsimp"
using del_x_mi_lets_in_minNull[of x mi ma deg ?xn ?h summary treeList ?l ?newnode ?newlist ?sn]
by (metis "12" "9" ‹high (summin * 2 ^ n + lx) n < length treeList› ‹summin * 2 ^ n + lx = (if x = mi then the (vebt_mint summary) * 2 ^ (deg div 2) + the (vebt_mint (treeList ! the (vebt_mint summary))) else x)› ‹x = mi› ‹x ≠ mi ∨ x ≠ ma› inrg nat_less_le ninNullc)
have newsummvalid: "invar_vebt ?sn m"
by (simp add: "5.IH"(2))
have 111: "(∀ i < 2^m. (∃ x. both_member_options (?newlist ! i) x) ⟷ ( both_member_options ?sn i))"
proof
fix i
show " i < 2^m ⟶ ((∃ x. both_member_options (?newlist ! i) x) = ( both_member_options ?sn i))"
proof
assume "i < 2^m"
show "(∃ x. both_member_options (?newlist ! i) x) = ( both_member_options ?sn i)"
proof(cases "i = ?h")
case True
hence 1000:"?newlist ! i = ?newnode"
using hprolist by fastforce
hence 1001:"∄ x. vebt_member (?newlist ! i) x"
by (simp add: min_Null_member ninNullc)
hence 1002: "∄ x. both_member_options (?newlist ! i) x"
using "1000" nnvalid valid_member_both_member_options by auto
have 1003: "¬ both_member_options ?sn i"
using "1" True dele_bmo_cont_corr by auto
then show ?thesis
using "1002" by blast
next
case False
hence 1000:"?newlist ! i = treeList ! i"
using ‹i < 2 ^ m› nothprolist by blast
hence "both_member_options (?newlist ! i) y ⟹ both_member_options ?sn i" for y
using "1" "4" False ‹i < 2 ^ m› dele_bmo_cont_corr by auto
moreover have "both_member_options ?sn i ⟹ ∃ y. both_member_options (?newlist ! i) y"
proof-
assume "both_member_options ?sn i "
hence "both_member_options summary i"
using "1" dele_bmo_cont_corr by auto
thus " ∃ y. both_member_options (?newlist ! i) y"
using "1000" "4" ‹i < 2 ^ m› by presburger
qed
then show ?thesis
using calculation by blast
qed
qed
qed
have 112:" (?xn = ?newma ⟶ (∀ t ∈ set ?newlist. ∄ x. both_member_options t x))"
proof
assume aampt:"?xn = ?newma"
show "(∀ t ∈ set ?newlist. ∄ y. both_member_options t y)"
proof(cases "?xn = ma")
case True
let ?maxs = "vebt_maxt ?sn"
show ?thesis
proof(cases "?maxs = None")
case True
hence aa:"∄ y. vebt_member ?sn y"
using maxt_corr_help_empty newsummvalid set_vebt'_def by auto
hence "∄ y. both_member_options ?sn y"
using newsummvalid valid_member_both_member_options by blast
hence "t ∈ set ?newlist ⟹ ∄y. both_member_options t y" for t
proof-
assume "t ∈ set ?newlist"
then obtain i where "?newlist ! i = t ∧ i< 2^m"
by (metis "2" ‹length treeList = length (treeList [high (summin * 2 ^ n + lx) n := vebt_delete (treeList ! high (summin * 2 ^ n + lx) n) (low (summin * 2 ^ n + lx) n)])› in_set_conv_nth)
thus " ∄y. both_member_options t y"
using "111" ‹∄y. both_member_options (vebt_delete summary (high (summin * 2 ^ n + lx) n)) y› by blast
qed
then show ?thesis by blast
next
case False
then obtain maxs where "Some maxs = ?maxs"
by fastforce
hence "both_member_options summary maxs"
by (metis "1" dele_bmo_cont_corr maxbmo)
have bb:"maxs ≠ ?h ∧ maxs < 2^m"
by (metis "1" ‹Some maxs = vebt_maxt ?sn› dele_bmo_cont_corr maxbmo member_bound valid_member_both_member_options)
hence "invar_vebt (?newlist ! maxs) n"using 0
by (simp add: "2" allvalidinlist)
hence "∃ y. both_member_options (?newlist ! maxs) y"
using "4" bb ‹both_member_options summary maxs› nothprolist by presburger
then obtain maxi where "Some maxi = vebt_maxt (?newlist ! maxs)"
by (smt (z3) VEBT_Member.vebt_member.simps(2) ‹invar_vebt (?newlist ! maxs) n› vebt_maxt.elims minNull.simps(1) min_Null_member valid_member_both_member_options)
hence "maxs = high ?xn n ∧ both_member_options (?newlist ! maxs) (low ?xn n)"
by (smt (z3) "9" False True ‹Some maxs = vebt_maxt (vebt_delete summary ?h)› ‹invar_vebt (?newlist ! maxs) n› aampt option.sel high_inv low_inv maxbmo maxt_member member_bound mult.commute)
hence False
using bb by blast
then show ?thesis by simp
qed
next
case False
hence "?xn ≠ ?newma" by simp
hence False using aampt by simp
then show ?thesis by blast
qed
qed
have 114: "?newma < 2^deg ∧ ?xn ≤ ?newma"
proof(cases "?xn = ma")
case True
hence "?xn = ma" by simp
let ?maxs = "vebt_maxt ?sn"
show ?thesis
proof(cases "?maxs = None")
case True
then show ?thesis
using "5.hyps"(8) ‹?xn = ma› by force
next
case False
then obtain maxs where "Some maxs = ?maxs"
by fastforce
hence "both_member_options summary maxs"
by (metis "1" dele_bmo_cont_corr maxbmo)
have bb:"maxs ≠ ?h ∧ maxs < 2^m"
by (metis "1" ‹Some maxs = vebt_maxt ?sn› dele_bmo_cont_corr maxbmo member_bound valid_member_both_member_options)
hence "invar_vebt (?newlist ! maxs) n"using 0 by (simp add: "2" allvalidinlist)
hence "∃ y. both_member_options (?newlist ! maxs) y"
using "4" ‹both_member_options summary maxs› bb nothprolist by presburger
then obtain maxi where "Some maxi = vebt_maxt (?newlist ! maxs)"
using ‹invar_vebt (treeList [high (summin * 2 ^ n + lx) n := vebt_delete (treeList ! high (summin * 2 ^ n + lx) n) (low (summin * 2 ^ n + lx) n)] ! maxs) n› maxt_corr_help_empty set_vebt'_def valid_member_both_member_options by fastforce
hence abc:"?newma = 2^n * maxs + maxi"
by (smt (z3) "9" True ‹Some maxs = vebt_maxt (vebt_delete summary (high (summin * 2 ^ n + lx) n))› option.sel not_None_eq)
have abd:"maxi < 2^n"
by (metis ‹Some maxi = vebt_maxt (?newlist ! maxs)› ‹invar_vebt (?newlist ! maxs) n› maxt_member member_bound)
have "high ?xn n ≤ maxs"
using "1" ‹Some summin = vebt_mint summary› ‹both_member_options summary maxs› ‹vebt_member (treeList ! summin) lx› ‹invar_vebt (treeList ! summin) n› high_inv member_bound mint_corr_help valid_member_both_member_options by force
then show ?thesis
proof(cases "high ?xn n = maxs")
case True
then show ?thesis
using bb by fastforce
next
case False
hence "high ?xn n < maxs"
by (simp add: ‹high (summin * 2 ^ n + lx) n ≤ maxs› order.not_eq_order_implies_strict)
hence "?newma < 2^deg"
by (smt (z3) "5.hyps"(8) "9" ‹Some maxi = vebt_maxt (?newlist ! maxs)› ‹Some maxs = vebt_maxt (vebt_delete summary (high (summin * 2 ^ n + lx) n))› ‹invar_vebt (?newlist ! maxs) n› abd bb both_member_options_equiv_member option.sel high_inv less_le_trans low_inv maxt_member mult.commute nothprolist verit_comp_simplify1(3) yhelper)
moreover have "high ?xn n < high ?newma n"
by (smt (z3) "9" True ‹Some maxi = vebt_maxt (?newlist ! maxs)› ‹Some maxs = vebt_maxt (vebt_delete summary (high (summin * 2 ^ n + lx) n))› ‹high (summin * 2 ^ n + lx) n < maxs› abd option.sel high_inv mult.commute option.discI)
ultimately show ?thesis
by (metis div_le_mono high_def linear not_less)
qed
qed
next
case False
then show ?thesis
by (smt (z3) "12" "5.hyps"(7) "5.hyps"(8) "9" both_member_options_from_complete_tree_to_child dual_order.trans hlbound one_le_numeral xnin yhelper)
qed
have 115: "?xn ≠ ?newma ⟶
(∀ i < 2^m.
(high ?newma n = i ⟶ both_member_options (?newlist ! i) (low ?newma n)) ∧
(∀ y. (high y n = i ∧ both_member_options (?newlist ! i) (low y n) ) ⟶ ?xn < y ∧ y ≤ ?newma))"
proof
assume assumption0:"?xn ≠ ?newma"
show " (∀ i < 2^m.
(high ?newma n = i ⟶ both_member_options (?newlist ! i) (low ?newma n)) ∧
(∀ y. (high y n = i ∧ both_member_options (?newlist ! i) (low y n) ) ⟶ ?xn < y ∧ y ≤ ?newma))"
proof
fix i
show "i < 2^m ⟶
(high ?newma n = i ⟶ both_member_options (?newlist ! i) (low ?newma n)) ∧
(∀ y. (high y n = i ∧ both_member_options (?newlist ! i) (low y n) ) ⟶ ?xn < y ∧ y ≤ ?newma)"
proof
assume assumption:"i < 2^m"
show " (high ?newma n = i ⟶ both_member_options (?newlist ! i) (low ?newma n)) ∧
(∀ y. (high y n = i ∧ both_member_options (?newlist ! i) (low y n) ) ⟶ ?xn < y ∧ y ≤ ?newma)"
proof-
have "(high ?newma n = i ⟶ both_member_options (?newlist ! i) (low ?newma n))"
proof
assume newmaassm: "high ?newma n = i"
thus " both_member_options (?newlist ! i) (low ?newma n)"
proof(cases "?xn = ma" )
case True
hence bb:"?xn = ma" by simp
let ?maxs = "vebt_maxt ?sn"
show ?thesis
proof(cases "?maxs = None")
case True
hence "?newma = ?xn" using assumption Let_def bb by simp
hence False using assumption0 by simp
then show ?thesis by simp
next
case False
then obtain maxs where "Some maxs = ?maxs"
by fastforce
hence "both_member_options summary maxs"
by (metis "1" dele_bmo_cont_corr maxbmo)
have bb:"maxs ≠ ?h ∧ maxs < 2^m"
by (metis "1" ‹Some maxs = vebt_maxt ?sn› dele_bmo_cont_corr maxbmo member_bound valid_member_both_member_options)
hence "invar_vebt (?newlist ! maxs) n"using 0 by (simp add: "2" allvalidinlist)
hence "∃ y. both_member_options (?newlist ! maxs) y"
using "4" ‹both_member_options summary maxs› bb nothprolist by presburger
then obtain maxi where "Some maxi = vebt_maxt (?newlist ! maxs)"
using ‹invar_vebt (treeList [high (summin * 2 ^ n + lx) n := vebt_delete (treeList ! high (summin * 2 ^ n + lx) n) (low (summin * 2 ^ n + lx) n)] ! maxs) n› maxt_corr_help_empty set_vebt'_def valid_member_both_member_options by fastforce
then show ?thesis
by (metis "1" "10" "9" True ‹Some summin = vebt_mint summary› ‹both_member_options summary maxs› ‹vebt_member (treeList ! summin) lx› ‹mi ≠ ma ∧ x < 2 ^ deg› ‹invar_vebt (treeList ! summin) n› bb equals0D high_inv le_antisym maxt_corr_help maxt_corr_help_empty mem_Collect_eq member_bound mint_corr_help option.collapse summaxma set_vebt'_def valid_member_both_member_options)
qed
next
case False
hence ccc:"?newma = ma" by simp
then show ?thesis
proof(cases "?xn = ma")
case True
hence "?xn = ?newma"
using False by blast
hence False
using False by auto
then show ?thesis by simp
next
case False
hence "both_member_options (?newlist ! high ma n) (low ma n)"
by (metis "1" ‹both_member_options (treeList ! high ma n) (low ma n)› ‹vebt_member (treeList ! summin) lx› ‹vebt_member summary (high ma n)› ‹invar_vebt (treeList ! summin) n› bit_split_inv dele_bmo_cont_corr high_inv hprolist member_bound nothprolist)
moreover have "high ma n = i ∧ low ma n = low ?newma n" using ccc newmaassm by simp
ultimately show ?thesis by simp
qed
qed
qed
moreover have " (∀ y. (high y n = i ∧ both_member_options (?newlist ! i) (low y n) ) ⟶ ?xn < y ∧ y ≤ ?newma)"
proof
fix y
show "(high y n = i ∧ both_member_options (?newlist ! i) (low y n) ) ⟶ ?xn < y ∧ y ≤ ?newma"
proof
assume yassm: "(high y n = i ∧ both_member_options (?newlist ! i) (low y n) )"
hence "?xn < y"
proof(cases "i = ?h")
case True
hence "both_member_options (treeList ! i) (low y n)"
using ‹vebt_member (treeList ! summin) lx› ‹invar_vebt (treeList ! summin) n› dele_bmo_cont_corr high_inv hprolist member_bound yassm by auto
then show ?thesis
using True hprolist min_Null_member ninNullc nnvalid valid_member_both_member_options yassm by fastforce
next
case False
hence "i ≤ ?h ⟹ False"
by (metis "1" "111" ‹Some summin = vebt_mint summary› ‹vebt_member (treeList ! summin) lx› ‹invar_vebt (treeList ! summin) n› assumption dele_bmo_cont_corr high_inv le_antisym member_bound mint_corr_help valid_member_both_member_options yassm)
hence "i > ?h"
using leI by blast
then show ?thesis
by (metis div_le_mono high_def not_less yassm)
qed
moreover have "y ≤ ?newma"
proof(cases "?xn = ma")
case True
hence "?xn= ma" by simp
let ?maxs = "vebt_maxt ?sn"
show ?thesis
proof(cases "?maxs = None")
case True
then show ?thesis
using "1" "111" assumption dele_bmo_cont_corr nothprolist yassm yhelper by auto
next
case False
then obtain maxs where "Some maxs = ?maxs"
by fastforce
hence "both_member_options summary maxs"
by (metis "1" dele_bmo_cont_corr maxbmo)
have bb:"maxs ≠ ?h ∧ maxs < 2^m"
by (metis "1" ‹Some maxs = vebt_maxt ?sn› dele_bmo_cont_corr maxbmo member_bound valid_member_both_member_options)
hence "invar_vebt (?newlist ! maxs) n"using 0 by (simp add: "2" allvalidinlist)
hence "∃ y. both_member_options (?newlist ! maxs) y"
using "4" ‹both_member_options summary maxs› bb nothprolist by presburger
then obtain maxi where "Some maxi = vebt_maxt (?newlist ! maxs)"
by (metis True ‹vebt_member (treeList ! summin) lx› ‹invar_vebt (treeList ! summin) n› assumption calculation dele_bmo_cont_corr high_inv hprolist leD member_bound nth_list_update_neq yassm yhelper)
hence "maxs < 2^m ∧ maxi < 2^n"
by (metis ‹invar_vebt (?newlist ! maxs) n› bb maxt_member member_bound)
hence "?newma = 2^n* maxs + maxi"
by (smt (z3) "9" False True ‹Some maxi = vebt_maxt (?newlist ! maxs)› ‹Some maxs = vebt_maxt (vebt_delete summary (high ?xn n))› option.sel)
hence "low ?newma n = maxi ∧ high ?newma n = maxs"
by (simp add: ‹maxs < 2 ^ m ∧ maxi < 2 ^ n› high_inv low_inv mult.commute)
hence "both_member_options (treeList ! (high y n)) (low y n)"
by (metis "1" "111" assumption dele_bmo_cont_corr nothprolist yassm)
hence hleqdraft:"high y n > maxs ⟹ False"
proof-
assume "high y n > maxs"
have "both_member_options summary (high y n)"
using "1" "111" assumption dele_bmo_cont_corr yassm by blast
moreover have "both_member_options ?sn (high y n)"
using "111" assumption yassm by blast
ultimately show False
using True ‹both_member_options (treeList ! high y n) (low y n)› ‹summin * 2 ^ n + lx < y› assumption leD yassm yhelper by blast
qed
hence hleqmaxs: "high y n ≤ maxs" by presburger
then show ?thesis
using ‹both_member_options (treeList ! high y n) (low y n)› assumption calculation dual_order.strict_trans1 yassm yhelper by auto
qed
next
case False
then show ?thesis
by (smt (z3) ‹vebt_member (treeList ! summin) lx› ‹invar_vebt (treeList ! summin) n› assumption dele_bmo_cont_corr high_inv hprolist member_bound nothprolist yassm yhelper)
qed
ultimately show " ?xn < y ∧ y ≤ ?newma" by simp
qed
qed
ultimately show ?thesis by simp
qed
qed
qed
qed
hence 117: "?newma < 2^deg" and 118: "?xn ≤ ?newma" using 114 by auto
have 116: " invar_vebt (Node (Some (?xn, ?newma)) deg ?newlist ?sn) deg"
using invar_vebt.intros(5)[of ?newlist n ?sn m deg ?xn ?newma]
using 3 allvalidinlist newlistlength newsummvalid "5.hyps"(3) 111 112 118 117 115 by fastforce
show ?thesis
using "116" dsimp by presburger
next
case False
hence notemp:"∃ z. both_member_options ?newnode z"
using not_min_Null_member by auto
let ?newma = "(if ?xn = ma then
?h * 2^(deg div 2) + the( vebt_maxt (?newlist ! ?h))
else ma)"
let ?delsimp =" (Node (Some (?xn, ?newma)) deg ?newlist summary)"
have dsimp:"vebt_delete (Node (Some (x, ma)) deg treeList summary) x = ?delsimp"
using del_x_mi_lets_in_not_minNull[of x mi ma deg ?xn ?h summary treeList ?l ?newnode ?newlist]
"12" "2" "9" False dual_order.eq_iff hlbound inrg order.not_eq_order_implies_strict xmi
by (metis ‹summin * 2 ^ n + lx = (if x = mi then the (vebt_mint summary) * 2 ^ (deg div 2) + the (vebt_mint (treeList ! the (vebt_mint summary))) else x)› ‹x ≠ mi ∨ x ≠ ma›)
have 111: "(∀ i < 2^m. (∃ x. both_member_options (?newlist ! i) x) ⟷ ( both_member_options summary i))"
proof
fix i
show " i < 2^m ⟶ ((∃ x. both_member_options (?newlist ! i) x) = ( both_member_options summary i))"
proof
assume "i < 2^m"
show "(∃ x. both_member_options (?newlist ! i) x) = ( both_member_options summary i)"
proof(cases "i = ?h")
case True
hence 1000:"?newlist ! i = ?newnode"
using hprolist by blast
hence 1001:"∃ x. vebt_member (?newlist ! i) x"
using nnvalid notemp valid_member_both_member_options by auto
hence 1002: "∃ x. both_member_options (?newlist ! i) x"
using "1000" notemp by presburger
have 1003: "both_member_options summary i"
using "4" True ‹∃z. both_member_options (treeList ! summin) z› ‹vebt_member (treeList ! summin) lx› ‹summin < 2 ^ m› ‹invar_vebt (treeList ! summin) n› high_inv member_bound by auto
then show ?thesis
using "1002" by blast
next
case False
hence 1000:"?newlist ! i = treeList ! i"
using ‹i < 2 ^ m› nothprolist by blast
then show ?thesis
using "4" ‹i < 2 ^ m› by presburger
qed
qed
qed
have 112:" (?xn = ?newma ⟶ (∀ t ∈ set ?newlist. ∄ x. both_member_options t x))"
proof
assume aampt:"?xn = ?newma"
show "(∀ t ∈ set ?newlist. ∄ y. both_member_options t y)"
proof(cases "?xn = ma")
case True
obtain maxi where " vebt_maxt (?newlist ! ?h) = Some maxi"
by (metis Collect_empty_eq False hprolist maxt_corr_help_empty nnvalid not_None_eq not_min_Null_member set_vebt'_def valid_member_both_member_options)
hence "both_member_options ?newnode maxi"
using hprolist maxbmo by auto
hence "both_member_options (treeList ! ?h) maxi"
using ‹vebt_member (treeList ! summin) lx› ‹invar_vebt (treeList ! summin) n› dele_bmo_cont_corr high_inv member_bound by force
hence False
by (metis "9" ‹both_member_options (vebt_delete (treeList ! high (summin * 2 ^ n + lx) n) (low (summin * 2 ^ n + lx) n)) maxi› ‹vebt_maxt (?newlist ! ?h) = Some maxi› ‹vebt_member (treeList ! summin) lx› ‹invar_vebt (treeList ! summin) n› aampt add_diff_cancel_left' dele_bmo_cont_corr option.sel high_inv low_inv member_bound)
then show ?thesis by blast
next
case False
then show ?thesis
using ‹mi ≠ ma ∧ x < 2 ^ deg› aampt by presburger
qed
qed
have 114: "?newma < 2^deg ∧ ?xn ≤ ?newma"
proof(cases "?xn = ma")
case True
hence "?xn = ma" by simp
obtain maxi where " vebt_maxt (?newlist ! ?h) = Some maxi"
by (metis "111" "2" "4" Collect_empty_eq True ‹both_member_options (treeList ! high ma n) (low ma n)› ‹high (summin * 2 ^ n + lx) n < length treeList› hprolist maxt_corr_help_empty nnvalid not_None_eq set_vebt'_def valid_member_both_member_options)
hence "both_member_options ?newnode maxi"
using hprolist maxbmo by auto
hence "both_member_options (treeList ! ?h) maxi"
using ‹vebt_member (treeList ! summin) lx› ‹invar_vebt (treeList ! summin) n› dele_bmo_cont_corr high_inv member_bound by force
hence "maxi < 2^n"
using ‹both_member_options?newnode maxi› member_bound nnvalid valid_member_both_member_options by blast
show ?thesis
by (smt (verit, ccfv_threshold) "3" "9" Euclidean_Division.div_eq_0_iff True ‹Some lx = vebt_mint (treeList ! summin)› ‹both_member_options (treeList ! high (summin * 2 ^ n + lx) n) maxi› ‹vebt_maxt (?newlist ! high (summin * 2 ^ n + lx) n) = Some maxi› ‹vebt_member (treeList ! summin) lx› ‹invar_vebt (treeList ! summin) n› add.right_neutral add_left_mono div_mult2_eq div_mult_self3 option.sel high_inv hlbound le_0_eq member_bound mint_corr_help power_add power_not_zero rel_simps(28) valid_member_both_member_options)
next
case False
then show ?thesis
using "10" "5.hyps"(8) maxt_corr_help valid_member_both_member_options xnin by force
qed
have 115: "?xn ≠ ?newma ⟶
(∀ i < 2^m.
(high ?newma n = i ⟶ both_member_options (?newlist ! i) (low ?newma n)) ∧
(∀ y. (high y n = i ∧ both_member_options (?newlist ! i) (low y n) ) ⟶ ?xn < y ∧ y ≤ ?newma))"
proof
assume xnmassm:"?xn ≠ ?newma"
show " (∀ i < 2^m.
(high ?newma n = i ⟶ both_member_options (?newlist ! i) (low ?newma n)) ∧
(∀ y. (high y n = i ∧ both_member_options (?newlist ! i) (low y n) ) ⟶ ?xn < y ∧ y ≤ ?newma))"
proof
fix i
show "i < 2^m ⟶
(high ?newma n = i ⟶ both_member_options (?newlist ! i) (low ?newma n)) ∧
(∀ y. (high y n = i ∧ both_member_options (?newlist ! i) (low y n) ) ⟶ ?xn < y ∧ y ≤ ?newma)"
proof
assume assumption:"i < 2^m"
show " (high ?newma n = i ⟶ both_member_options (?newlist ! i) (low ?newma n)) ∧
(∀ y. (high y n = i ∧ both_member_options (?newlist ! i) (low y n) ) ⟶ ?xn < y ∧ y ≤ ?newma)"
proof-
have "(high ?newma n = i ⟶ both_member_options (?newlist ! i) (low ?newma n))"
proof
assume newmaassm: "high ?newma n = i"
thus " both_member_options (?newlist ! i) (low ?newma n)"
proof(cases "?xn = ma")
case True
obtain maxi where "vebt_maxt (?newlist ! ?h) = Some maxi"
by (metis Collect_empty_eq both_member_options_equiv_member hprolist maxt_corr_help_empty nnvalid not_Some_eq notemp set_vebt'_def)
hence "both_member_options (?newlist ! ?h) maxi"
using maxbmo by blast
then show ?thesis
by (smt (z3) "2" "9" True ‹Some lx = vebt_mint (treeList ! summin)› ‹high (summin * 2 ^ n + lx) n < length treeList› ‹vebt_member (treeList ! summin) lx› ‹invar_vebt (treeList ! summin) n› add_left_mono dele_bmo_cont_corr eq_iff high_inv hprolist low_inv member_bound mint_corr_help valid_member_both_member_options yhelper)
next
case False
hence abcd:"?newma = ma" by simp
then show ?thesis
proof(cases "high ma n = ?h")
case True
hence "?newlist ! high ma n = ?newnode"
using hprolist by presburger
then show ?thesis
proof(cases "low ma n = ?l")
case True
hence "?newma = ?xn"
by (metis "1" False ‹?newlist ! high ma n = vebt_delete (treeList ! high (summin * 2 ^ n + lx) n) (low (summin * 2 ^ n + lx) n)› ‹both_member_options (treeList ! high ma n) (low ma n)›
‹vebt_member (treeList ! summin) lx› ‹vebt_member summary (high ma n)› ‹invar_vebt (treeList ! summin) n› bit_split_inv dele_bmo_cont_corr high_inv member_bound nothprolist)
hence False
using False by presburger
then show ?thesis by simp
next
case False
have "both_member_options (treeList ! high ma n) (low ma n)"
by (simp add: ‹both_member_options (treeList ! high ma n) (low ma n)›)
hence "both_member_options ?newnode (low ma n)"
using False True ‹vebt_member (treeList ! summin) lx› ‹invar_vebt (treeList ! summin) n› dele_bmo_cont_corr high_inv member_bound by force
hence "both_member_options (?newlist ! high ma n) (low ma n)"
using True hprolist by presburger
then show ?thesis using abcd newmaassm by simp
qed
next
case False
hence "?newlist ! high ma n = treeList ! high ma n"
using "1" ‹vebt_member summary (high ma n)› member_bound nothprolist by blast
moreover hence "both_member_options (treeList ! high ma n) (low ma n)"
using ‹both_member_options (treeList ! high ma n) (low ma n)› by blast
ultimately show ?thesis using abcd newmaassm by simp
qed
qed
qed
moreover have " (∀ y. (high y n = i ∧ both_member_options (?newlist ! i) (low y n) ) ⟶ ?xn < y ∧ y ≤ ?newma)"
proof
fix y
show "(high y n = i ∧ both_member_options (?newlist ! i) (low y n) ) ⟶ ?xn < y ∧ y ≤ ?newma"
proof
assume yassm: "(high y n = i ∧ both_member_options (?newlist ! i) (low y n) )"
hence "?xn < y"
proof(cases "i = ?h")
case True
hence "both_member_options (treeList ! i) (low y n)"
using ‹vebt_member (treeList ! summin) lx› ‹invar_vebt (treeList ! summin) n› dele_bmo_cont_corr high_inv hprolist member_bound yassm by force
moreover have "vebt_mint (treeList ! i) = Some (low ?xn n)"
using True ‹Some lx = vebt_mint (treeList ! summin)› ‹vebt_member (treeList ! summin) lx› ‹invar_vebt (treeList ! summin) n› high_inv low_inv member_bound by presburger
moreover hence "low y n ≥ low ?xn n"
using True ‹vebt_member (treeList ! summin) lx› ‹invar_vebt (treeList ! summin) n› calculation(1) high_inv member_bound mint_corr_help valid_member_both_member_options by auto
moreover have "low y n ≠ low ?xn n"
using True ‹vebt_member (treeList ! summin) lx› ‹invar_vebt (treeList ! summin) n› dele_bmo_cont_corr high_inv hprolist member_bound yassm by auto
ultimately have "low y n > low ?xn n" by simp
show ?thesis
by (metis True ‹low (summin * 2 ^ n + lx) n ≤ low y n› ‹low y n ≠ low (summin * 2 ^ n + lx) n› bit_concat_def bit_split_inv leD linorder_neqE_nat nat_add_left_cancel_less yassm)
next
case False
have "Some (high ?xn n) = vebt_mint summary"
using ‹Some summin = vebt_mint summary› ‹vebt_member (treeList ! summin) lx› ‹invar_vebt (treeList ! summin) n› high_inv member_bound by presburger
moreover hence "high y n ≥ high ?xn n"
by (metis "1" "111" assumption mint_corr_help valid_member_both_member_options yassm)
ultimately show ?thesis
by (metis False div_le_mono high_def leI le_antisym yassm)
qed
moreover have "y ≤ ?newma"
by (smt (z3) ‹vebt_member (treeList ! summin) lx› ‹invar_vebt (treeList ! summin) n› assumption calculation dele_bmo_cont_corr high_inv hprolist leD member_bound nothprolist yassm yhelper)
ultimately show " ?xn < y ∧ y ≤ ?newma" by simp
qed
qed
ultimately show ?thesis by simp
qed
qed
qed
qed
hence 117: "?newma < 2^deg" and 118: "?xn ≤ ?newma" using 114 by auto
have 116: " invar_vebt (Node (Some (?xn, ?newma)) deg ?newlist summary) deg"
using invar_vebt.intros(5)[of ?newlist n summary m deg ?xn ?newma] allvalidinlist
1 newlistlength 8 3 111 112 117 118 115 by fastforce
hence "invar_vebt (?delsimp) deg" by simp
moreover obtain delsimp where 118:"delsimp = ?delsimp" by simp
ultimately have 119:"invar_vebt delsimp deg" by simp
have "vebt_delete (Node (Some (x, ma)) deg treeList summary) x = delsimp" using dsimp 118 by simp
hence "delsimp = vebt_delete (Node (Some (x, ma)) deg treeList summary) x" by simp
then show ?thesis using 119
using xmi by auto
qed
qed
qed
qed
qed
corollary dele_member_cont_corr:"invar_vebt t n ⟹ (vebt_member (vebt_delete t x) y ⟷ x ≠ y ∧ vebt_member t y)"
by (meson both_member_options_equiv_member dele_bmo_cont_corr delete_pres_valid)
subsection ‹Correctness with Respect to Set Interpretation›
theorem delete_correct': assumes "invar_vebt t n"
shows "set_vebt' (vebt_delete t x) = set_vebt' t - {x}"
using assms by(auto simp add: set_vebt'_def dele_member_cont_corr)
corollary delete_correct: assumes "invar_vebt t n"
shows "set_vebt' (vebt_delete t x) = set_vebt t - {x}"
using assms delete_correct' set_vebt_set_vebt'_valid by auto
end
end
Theory VEBT_Uniqueness
theory VEBT_Uniqueness imports VEBT_InsertCorrectness VEBT_Succ VEBT_Pred VEBT_DeleteCorrectness
begin
context VEBT_internal begin
section ‹Uniqueness Property of valid Trees›
text ‹Two valid van Emde Boas trees having equal degree number and representing the same integer set are equal.›
theorem uniquetree: "invar_vebt t n ⟹ invar_vebt s n ⟹ set_vebt' t = set_vebt' s ⟹ s = t"
proof(induction t n arbitrary: s rule: invar_vebt.induct)
case (1 a b)
then show ?case
apply(cases "vebt_member t 0")
apply(cases "vebt_member t 1")
apply(cases "vebt_member t 1")
apply (smt (z3) "1.prems"(1) "1.prems"(2) VEBT_Member.vebt_member.simps(1) One_nat_def deg_1_Leafy deg_not_0 less_not_refl mem_Collect_eq set_vebt'_def) +
done
next
case (2 treeList n summary m deg)
from 2(9) obtain treeList' summary' where sprop:"s = Node None deg treeList' summary' ∧ deg = n+m
∧ length treeList' =2^m ∧ invar_vebt summary' m ∧ (∀ t ∈ set treeList'. invar_vebt t n) ∧
(∄i. both_member_options summary' i)"
apply(cases)
using "2.hyps"(3) "2.hyps"(4) one_is_add apply force
apply (metis "2.hyps"(3) "2.hyps"(4) add_self_div_2)
apply (metis "2.hyps"(3) "2.hyps"(4) One_nat_def add_self_div_2 div_greater_zero_iff even_Suc_div_two not_numeral_le_zero odd_add order.not_eq_order_implies_strict plus_1_eq_Suc zero_le_one zero_neq_one)
apply (metis "2.prems"(1) "2.prems"(2) VEBT_Member.vebt_member.simps(2) Suc_1 add_leD1 add_self_div_2 both_member_options_def deg_not_0 div_greater_zero_iff empty_Collect_eq membermima.simps(4) nat_le_iff_add plus_1_eq_Suc set_vebt'_def valid_member_both_member_options)
apply (metis "2.hyps"(3) "2.hyps"(4) add_self_div_2 div2_Suc_Suc even_Suc_div_two odd_add one_is_add plus_1_eq_Suc zero_neq_one)
done
from 2(9) have aa:"∀ t ∈ set treeList'. invar_vebt t n" using sprop by simp
have ac:"deg ≥ 2"
by (metis "2.hyps"(3) add_self_div_2 deg_not_0 div_greater_zero_iff sprop)
hence ab:"∀ t ∈ set treeList. set_vebt' t = {}"
by (metis "2.hyps"(6) empty_Collect_eq min_Null_member not_min_Null_member set_vebt'_def)
hence ac:"length treeList' =length treeList"
by (simp add: "2.hyps"(2) sprop)
hence membercongy:"i < 2^m ⟹ vebt_member (treeList! i) x ⟷ vebt_member (treeList' ! i) x" for i x
proof-
assume "i < 2^m"
show "vebt_member (treeList! i) x ⟷ vebt_member (treeList' ! i) x"
proof
show "vebt_member (treeList ! i) x ⟹ vebt_member (treeList' ! i) x"
by (metis "2.hyps"(6) ‹i < 2 ^ m› ac min_Null_member not_min_Null_member nth_mem sprop)
show "vebt_member (treeList' ! i) x ⟹ vebt_member (treeList ! i) x"
proof-
assume "vebt_member (treeList' ! i) x"
hence "both_member_options (treeList' ! i) x"
by (metis ‹i < 2 ^ m› both_member_options_equiv_member nth_mem sprop)
hence "membermima (treeList' ! i) x ∨ naive_member (treeList' ! i) x" unfolding both_member_options_def by auto
moreover have "membermima (treeList' ! i) x ⟹ membermima s (2^m*i+x)"
using membermima.simps(5)[of "deg-1" treeList' summary' "(2^m*i+x)"] sprop ac
apply auto
apply (metis One_nat_def Suc_diff_1 ‹membermima (Node None (Suc (deg - 1)) treeList' summary') (2 ^ m * i + x) = (let pos = high (2 ^ m * i + x) (Suc (deg - 1) div 2) in if pos < length treeList' then membermima (treeList' ! pos) (low (2 ^ m * i + x) (Suc (deg - 1) div 2)) else False)› add.commute deg_not_0 neq0_conv not_add_less1)
by (smt (z3) "2.hyps"(3) Nat.add_0_right Suc_pred ‹i < 2 ^ m› ‹vebt_member (treeList' ! i) x› add_gr_0 add_self_div_2 deg_not_0 div_less div_mult_self4 high_def low_inv member_bound mult.commute nth_mem power_not_zero zero_neq_numeral)
moreover have "naive_member (treeList' ! i) x ⟹ naive_member s (2^m*i+x)"
using naive_member.simps(3)[of None "deg-1" treeList' summary' "(2^m*i+x)" ] sprop ac
apply auto
apply (metis One_nat_def Suc_pred' ‹naive_member (Node None (Suc (deg - 1)) treeList' summary') (2 ^ m * i + x) = (let pos = high (2 ^ m * i + x) (Suc (deg - 1) div 2) in if pos < length treeList' then naive_member (treeList' ! pos) (low (2 ^ m * i + x) (Suc (deg - 1) div 2)) else False)› add_gr_0 deg_not_0)
by (smt (z3) "2.hyps"(3) Nat.add_0_right Suc_pred ‹i < 2 ^ m› ‹vebt_member (treeList' ! i) x› add_gr_0 add_self_div_2 deg_not_0 div_less div_mult_self4 high_def low_inv member_bound mult.commute nth_mem power_not_zero zero_neq_numeral)
ultimately have "both_member_options s (2^m*i +x)" unfolding both_member_options_def by auto
hence False
using "2.prems"(1) VEBT_Member.vebt_member.simps(2) sprop valid_member_both_member_options by blast
then show ?thesis by simp
qed
qed
qed
hence ad:"i<2^m ⟹ set_vebt' (treeList' ! i ) = {}" for i
proof-
assume assm:"i < 2^m"
show "set_vebt' (treeList' ! i ) = {}"
proof(rule ccontr)
assume "set_vebt' (treeList' ! i ) ≠ {}"
then obtain y where "vebt_member (treeList' ! i) y"
using set_vebt'_def by fastforce
thus False
using ab ac assm membercongy sprop set_vebt'_def by force
qed
qed
hence ae:"i< 2^m ⟹ treeList' ! i = treeList ! i" for i
by (simp add: "2.IH"(1) "2.hyps"(2) ab sprop)
then show ?case
by (metis "2.IH"(2) "2.hyps"(1) "2.hyps"(5) ac both_member_options_equiv_member empty_Collect_eq list_eq_iff_nth_eq sprop set_vebt'_def)
next
case (3 treeList n summary m deg)
from 3(9) obtain treeList' summary' where sprop:"s = Node None deg treeList' summary' ∧ deg = n+m
∧ length treeList' =2^m ∧ invar_vebt summary' m ∧ (∀ t ∈ set treeList'. invar_vebt t n) ∧
(∄i. both_member_options summary' i)"
apply(cases)
apply (metis "3.IH"(1) "3.hyps"(2) "3.hyps"(3) "3.hyps"(4) One_nat_def Suc_1 not_one_le_zero one_is_add set_n_deg_not_0 zero_neq_numeral)
apply (metis "3.hyps"(3) "3.hyps"(4) add_self_div_2 div2_Suc_Suc even_Suc_div_two odd_add plus_1_eq_Suc)
apply (metis "3.hyps"(3) "3.hyps"(4) Suc_inject add_Suc_right add_self_div_2)
apply (metis "3.hyps"(3) "3.hyps"(4) add_Suc_right add_self_div_2 even_Suc_div_two le_add2 le_less_Suc_eq odd_add order.strict_iff_order plus_1_eq_Suc)
apply (metis "3.prems"(1) "3.prems"(2) VEBT_Member.vebt_member.simps(2) Suc_pred' both_member_options_def deg_not_0 mem_Collect_eq membermima.simps(4) set_vebt'_def valid_member_both_member_options)
done
have ac:"deg ≥ 2"
by (metis "3.hyps"(3) One_nat_def add_le_mono le_add1 numeral_2_eq_2 plus_1_eq_Suc set_n_deg_not_0 sprop)
hence ab:"∀ t ∈ set treeList. set_vebt' t = {}"
by (metis "3.hyps"(6) empty_Collect_eq min_Null_member not_min_Null_member set_vebt'_def)
hence ac:"length treeList' =length treeList"
by (simp add: "3.hyps"(2) sprop)
hence membercongy:"i < 2^m ⟹ vebt_member (treeList! i) x ⟷ vebt_member (treeList' ! i) x" for i x
proof-
assume "i < 2^m"
show "vebt_member (treeList! i) x ⟷ vebt_member (treeList' ! i) x"
proof
show "vebt_member (treeList ! i) x ⟹ vebt_member (treeList' ! i) x"
by (metis "3.hyps"(6) ‹i < 2 ^ m› ac min_Null_member not_min_Null_member nth_mem sprop)
show "vebt_member (treeList' ! i) x ⟹ vebt_member (treeList ! i) x"
proof-
assume "vebt_member (treeList' ! i) x"
hence "both_member_options (treeList' ! i) x"
by (metis ‹i < 2 ^ m› both_member_options_equiv_member nth_mem sprop)
hence "membermima (treeList' ! i) x ∨ naive_member (treeList' ! i) x"
unfolding both_member_options_def by auto
moreover have "membermima (treeList' ! i) x ⟹ membermima s (2^n*i+x)"
using membermima.simps(5)[of "deg-1" treeList' summary' "(2^n*i+x)"] sprop ac
by (smt (z3) "3.hyps"(3) "3.prems"(1) Nat.add_diff_assoc Suc_pred ‹i < 2 ^ m› ‹vebt_member (treeList' ! i) x› add_diff_cancel_left' add_self_div_2 deg_not_0 even_Suc high_inv le_add1 low_inv member_bound mult.commute mult_2 nth_mem odd_two_times_div_two_nat plus_1_eq_Suc)
moreover have "naive_member (treeList' ! i) x ⟹ naive_member s (2^n*i+x)"
using naive_member.simps(3)[of None "deg-1" treeList' summary' "(2^n*i+x)" ] sprop ac
by (smt (z3) "3.hyps"(3) "3.prems"(1) Nat.add_0_right Nat.add_diff_assoc Suc_pred ‹i < 2 ^ m› ‹vebt_member (treeList' ! i) x› add_self_div_2 deg_not_0 div_less div_mult_self4 even_Suc_div_two high_def le_add1 low_inv member_bound mult.commute nth_mem odd_add plus_1_eq_Suc power_not_zero zero_neq_numeral)
ultimately have "both_member_options s (2^n*i +x)" unfolding both_member_options_def
by auto
hence False
using "3.prems"(1) VEBT_Member.vebt_member.simps(2) sprop valid_member_both_member_options
by blast
then show ?thesis by simp
qed
qed
qed
hence ad:"i<2^m ⟹ set_vebt' (treeList' ! i ) = {}" for i
proof-
assume assm:"i < 2^m"
show "set_vebt' (treeList' ! i ) = {}"
proof(rule ccontr)
assume "set_vebt' (treeList' ! i ) ≠ {}"
then obtain y where "vebt_member (treeList' ! i) y"
using set_vebt'_def by fastforce
thus False
using ab ac assm membercongy sprop set_vebt'_def by force
qed
qed
hence ae:"i< 2^m ⟹ treeList' ! i = treeList ! i" for i
by (simp add: "3.IH"(1) "3.hyps"(2) ab sprop)
then show ?case
by (metis "3.IH"(2) "3.hyps"(1) "3.hyps"(5) Collect_empty_eq ac both_member_options_equiv_member list_eq_iff_nth_eq sprop set_vebt'_def)
next
case (4 treeList n summary m deg mi ma)
note case4= this
hence "set_vebt' (Node (Some (mi, ma)) deg treeList summary) = set_vebt' s" by simp
hence a0:"deg ≥ 2" using 4
by (metis add_self_div_2 deg_not_0 div_greater_zero_iff)
hence aa:"{mi, ma} ⊆ set_vebt' (Node (Some (mi, ma)) deg treeList summary)"
apply auto using vebt_member.simps(5)[of mi ma "deg -2" treeList summary mi]
apply (metis add_2_eq_Suc' le_add_diff_inverse2 mem_Collect_eq set_vebt'_def)
using vebt_member.simps(5)[of mi ma "deg -2" treeList summary ma]
apply (metis add_2_eq_Suc' le_add_diff_inverse2 mem_Collect_eq set_vebt'_def)
done
from 4(12) obtain treeList' summary' info where sprop1:"s = Node info deg treeList' summary' ∧ deg = n+m
∧ length treeList' =2^m ∧ invar_vebt summary' m ∧ (∀ t ∈ set treeList'. invar_vebt t n) "
apply cases
using "4.hyps"(3) "4.hyps"(4) one_is_add apply force
apply (metis "4.hyps"(3) "4.hyps"(4) add_self_div_2)
apply (metis "4.hyps"(3) "4.hyps"(4) even_Suc odd_add)
apply (metis "4.hyps"(3) "4.hyps"(4) add_self_div_2)
apply (metis "4.hyps"(3) "4.hyps"(4) even_Suc odd_add)
done
have ac:"invar_vebt t h ⟹ invar_vebt k h ⟹ set_vebt' t = set_vebt' k ⟹ vebt_mint t = vebt_mint k" for t k h
proof-
assume assms: "invar_vebt t h" "invar_vebt k h" "set_vebt' t = set_vebt' k"
have "¬ vebt_mint t = vebt_mint k ⟹ False"
proof-
assume "vebt_mint t ≠ vebt_mint k"
then obtain a b where abdef:"vebt_mint t = None ∧ vebt_mint k = Some b ∨
vebt_mint t = Some a ∧ vebt_mint k = None ∨
a < b ∧ Some a = vebt_mint t ∧ Some b = vebt_mint k ∨
b < a ∧ Some a = vebt_mint t ∧ Some b = vebt_mint k"
by (metis linorder_neqE_nat option.exhaust)
show False
apply(cases "vebt_mint t = None ∧ vebt_mint k = Some b")
apply (metis ‹vebt_mint t ≠ vebt_mint k› assms(1) assms(2) assms(3) mint_corr mint_sound)
apply(cases " vebt_mint t = Some a ∧ vebt_mint k = None")
apply (metis ‹vebt_mint t ≠ vebt_mint k› assms(1) assms(2) assms(3) mint_corr mint_sound)
apply (cases "a < b ∧ Some a = vebt_mint t ∧ Some b = vebt_mint k")
apply (metis ‹vebt_mint t ≠ vebt_mint k› assms(1) assms(2) assms(3) mint_corr mint_sound)
apply (metis ‹vebt_mint t ≠ vebt_mint k› abdef assms(1) assms(2) assms(3) mint_corr mint_sound)
done
qed
thus "vebt_mint t = vebt_mint k" by auto
qed
have ad:"invar_vebt t h ⟹ invar_vebt k h ⟹ set_vebt' t = set_vebt' k ⟹ vebt_maxt t = vebt_maxt k" for t k h
proof-
assume assms: "invar_vebt t h" "invar_vebt k h" "set_vebt' t = set_vebt' k"
have "¬ vebt_maxt t = vebt_maxt k ⟹ False"
proof-
assume "vebt_maxt t ≠ vebt_maxt k"
then obtain a b where abdef:"vebt_maxt t = None ∧ vebt_maxt k = Some b ∨
vebt_maxt t = Some a ∧ vebt_maxt k = None ∨
a < b ∧ Some a = vebt_maxt t ∧ Some b = vebt_maxt k ∨
b < a ∧ Some a = vebt_maxt t ∧ Some b = vebt_maxt k"
by (metis linorder_neqE_nat option.exhaust)
show False apply(cases "vebt_maxt t = None ∧ vebt_maxt k = Some b")
apply (metis ‹vebt_maxt t ≠ vebt_maxt k› assms(1) assms(2) assms(3) maxt_corr maxt_sound)
apply(cases " vebt_maxt t = Some a ∧ vebt_maxt k = None")
apply (metis ‹vebt_maxt t ≠ vebt_maxt k› assms(1) assms(2) assms(3) maxt_corr maxt_sound)
apply (cases "a < b ∧ Some a = vebt_maxt t ∧ Some b = vebt_maxt k")
apply (metis ‹vebt_maxt t ≠ vebt_maxt k› assms(1) assms(2) assms(3) maxt_corr maxt_sound)
by (metis ‹vebt_maxt t ≠ vebt_maxt k› abdef assms(1) assms(2) assms(3) maxt_corr maxt_sound)
qed
thus "vebt_maxt t = vebt_maxt k" by auto
qed
have infsplit: "info = Some (mi ,ma)" using 4(12)
proof cases
case (1 a b)
then show ?thesis
using sprop1 by blast
next
case (2 treeList n summary m)
then show ?thesis
by (metis "4.prems"(2) Collect_empty_eq VEBT_Member.vebt_member.simps(2) aa empty_iff insert_subset set_vebt'_def)
next
case (3 treeList n summary m)
then show ?thesis
by (metis "4.prems"(2) Collect_empty_eq VEBT_Member.vebt_member.simps(2) aa empty_iff insert_subset set_vebt'_def)
next
case (4 treeList' n' summary' m' mi' ma')
have "vebt_mint s = Some mi'"
by (simp add: "4"(1))
hence "mi' = mi"
by (smt (verit, ccfv_threshold) "4.hyps"(7) "4.prems"(1) "4.prems"(2) VEBT_Member.vebt_member.simps(5) One_nat_def a0 aa add.assoc eq_iff insert_subset leI le_add_diff_inverse less_imp_le_nat mem_Collect_eq min_in_set_def mint_sound numeral_2_eq_2 option.sel order.not_eq_order_implies_strict plus_1_eq_Suc set_vebt'_def)
have "vebt_maxt s = Some ma'"
by (simp add: "4"(1))
hence "ma' < ma ⟹ ma∉ set_vebt' s"
by (meson "4.prems"(1) leD max_in_set_def maxt_corr)
moreover have "ma < ma' ⟹ ma' ∉ set_vebt' (Node (Some (mi, ma)) deg treeList summary)" using case4
by (metis dual_order.strict_trans2 mem_Collect_eq member_inv not_less_iff_gr_or_eq set_vebt'_def)
ultimately have "ma'=ma"
by (metis ‹vebt_maxt s = Some ma'› aa case4(12) case4(13) insert_subset max_in_set_def maxt_corr not_less_iff_gr_or_eq)
then show ?thesis
using "4"(1) ‹mi' = mi› sprop1 by force
next
case (5 treeList n summary m mi' ma')
have "vebt_mint s = Some mi'"
by (simp add: "5"(1))
hence "mi' = mi"
by (smt (verit, ccfv_threshold) "4.hyps"(7) "4.prems"(1) "4.prems"(2) VEBT_Member.vebt_member.simps(5) One_nat_def a0 aa add.assoc eq_iff insert_subset leI le_add_diff_inverse less_imp_le_nat mem_Collect_eq min_in_set_def mint_sound numeral_2_eq_2 option.sel order.not_eq_order_implies_strict plus_1_eq_Suc set_vebt'_def)
have "vebt_maxt s = Some ma'"
by (simp add: "5"(1))
hence "ma' < ma ⟹ ma∉ set_vebt' s"
by (meson "4.prems"(1) leD max_in_set_def maxt_corr)
moreover have "ma < ma' ⟹ ma' ∉ set_vebt' (Node (Some (mi, ma)) deg treeList summary)" using case4
by (metis dual_order.strict_trans2 mem_Collect_eq member_inv not_less_iff_gr_or_eq set_vebt'_def)
ultimately have "ma'=ma"
by (metis "5"(5) "5"(6) case4(5) case4(6) even_Suc odd_add)
then show ?thesis
using "5"(1) ‹mi' = mi› sprop1 by force
qed
from 4(12) have acd:"mi ≠ ma ⟶
(∀i<2 ^ m.
(high ma n = i ⟶ both_member_options (treeList' ! i) (low ma n)) ∧
(∀x. high x n = i ∧ both_member_options (treeList' ! i) (low x n) ⟶ mi < x ∧ x ≤ ma))"
apply cases using sprop1 apply simp
using sprop1 infsplit apply simp
using sprop1 infsplit apply simp
apply (metis VEBT.inject(1) add_self_div_2 case4(5) infsplit option.inject prod.inject sprop1)
by (metis case4(5) case4(6) even_Suc odd_add)
hence "length treeList' = 2^m"
using sprop1 by fastforce
hence aca:"length treeList' =length treeList" using "4.hyps"(2)
by (simp add: "4.hyps"(2) sprop1)
from 4(12) have sumtreelistcong: " ∀i<2 ^ m. (∃x. both_member_options (treeList' ! i) x) = both_member_options summary' i"
apply cases
using a0 apply linarith
apply (metis VEBT.inject(1) nth_mem sprop1)
using infsplit sprop1 apply force
apply (metis VEBT.inject(1) sprop1)
using sprop1 by auto
hence membercongy:"i < 2^m ⟹ vebt_member (treeList! i) x ⟷ vebt_member (treeList' ! i) x" for i x
proof-
assume "i < 2^m"
show "vebt_member (treeList! i) x ⟷ vebt_member (treeList' ! i) x"
proof
show "vebt_member (treeList ! i) x ⟹ vebt_member (treeList' ! i) x"
proof-
assume "vebt_member (treeList ! i) x"
hence aaa:"both_member_options (treeList ! i) x"
by (metis ‹i < 2 ^ m› both_member_options_equiv_member case4(1) case4(4) nth_mem)
have "x < 2^n"
by (metis ‹i < 2 ^ m› ‹vebt_member (treeList ! i) x› case4(1) case4(4) member_bound nth_mem)
hence "vebt_member (Node (Some (mi, ma)) deg treeList summary) (2^n*i+x)"
using both_member_options_from_chilf_to_complete_tree
[of " (2^n*i+x)" deg treeList mi ma summary] aaa high_inv[of x n i]
by (smt (z3) VEBT_Member.vebt_member.simps(5) Suc_diff_Suc Suc_leD ‹i < 2 ^ m› ‹vebt_member (treeList ! i) x› a0 add_self_div_2 case4(11) case4(4) case4(5) case4(8) le_add_diff_inverse le_less_Suc_eq le_neq_implies_less low_inv mult.commute nat_1_add_1 not_less_iff_gr_or_eq nth_mem plus_1_eq_Suc sprop1)
have "mi < (2^n*i+x) ∧ (2^n*i+x) ≤ ma" using vebt_mint.simps(3)[of mi ma deg treeList summary]
by (metis ‹i < 2 ^ m› ‹x < 2 ^ n› aaa case4(11) case4(4) case4(8) high_inv low_inv mult.commute nth_mem)
moreover have "both_member_options s (2^m*i +x)"
using ‹vebt_member (Node (Some (mi, ma)) deg treeList summary) (2 ^ n * i + x)› both_member_options_equiv_member case4(12) case4(13) case4(5) set_vebt'_def by auto
hence "both_member_options (treeList' ! i) x"
by (smt (z3) ‹i < 2 ^ m› acd ‹x < 2 ^ n› a0 add_leD1 add_self_div_2 both_member_options_from_complete_tree_to_child calculation case4(5) high_inv infsplit low_inv mult.commute nat_neq_iff numeral_2_eq_2 plus_1_eq_Suc sprop1)
then show ?thesis
by (metis ‹i < 2 ^ m› nth_mem sprop1 valid_member_both_member_options)
qed
show "vebt_member (treeList' ! i) x ⟹ vebt_member (treeList ! i) x"
proof-
assume "vebt_member (treeList' ! i) x"
hence "vebt_member s (2^n*i +x)" using sprop1 both_member_options_from_chilf_to_complete_tree
[of "(2^n*i +x)" deg treeList' mi ma summary']
by (smt (z3) Nat.add_0_right ‹i < 2 ^ m› a0 add_leD1 add_self_div_2 both_member_options_equiv_member case4(12) case4(5) div_less div_mult_self4 high_def infsplit low_inv member_bound mult.commute nat_1_add_1 nth_mem power_not_zero zero_neq_numeral)
hence "mi < (2^n*i +x) ∧ (2^n*i +x) ≤ ma "
using vebt_mint.simps(3)[of mi ma deg treeList' summary'] vebt_maxt.simps(3)[of mi ma deg treeList' summary']
by (metis ‹i < 2 ^ m› ‹vebt_member (treeList' ! i) x› acd both_member_options_equiv_member case4(12) high_inv infsplit low_inv member_bound mi_eq_ma_no_ch mult.commute nth_mem sprop1)
moreover have "both_member_options (Node (Some (mi, ma)) deg treeList summary) (2^m*i +x)"
by (metis ‹vebt_member s (2 ^ n * i + x)› add_leD1 both_member_options_equiv_member both_member_options_from_chilf_to_complete_tree calculation case4(1) case4(13) case4(5) maxbmo vebt_maxt.simps(3) mem_Collect_eq member_inv nat_neq_iff nth_mem one_add_one set_vebt'_def)
hence "both_member_options (treeList ! i) x"
using both_member_options_from_complete_tree_to_child[of deg mi ma treeList summary "(2^n*i +x)"]
by (smt (z3) Nat.add_0_right Suc_leD ‹i < 2 ^ m› ‹vebt_member (treeList' ! i) x› a0 add_self_div_2 calculation case4(11) case4(5) div_less div_mult_self4 high_def low_inv member_bound mult.commute nat_1_add_1 nat_neq_iff nth_mem plus_1_eq_Suc power_not_zero sprop1 zero_neq_numeral)
then show ?thesis
by (metis ‹i < 2 ^ m› aca case4(1) nth_mem sprop1 valid_member_both_member_options)
qed
qed
qed
hence setcongy: "i < 2^m ⟹ set_vebt' (treeList ! i) = set_vebt' (treeList' ! i)" for i unfolding set_vebt'_def by presburger
hence treecongy: "i < 2^m ⟹ treeList ! i = treeList' ! i" for i
by (metis case4(1) case4(4) nth_mem sprop1)
hence "treeList = treeList'"
by (metis aca case4(4) nth_equalityI)
have "vebt_member summary x ⟷ vebt_member summary' x" for x
by (metis ‹treeList = treeList'› both_member_options_equiv_member case4(3) case4(7) member_bound sprop1 sumtreelistcong)
hence "set_vebt' summary = set_vebt' summary'" unfolding set_vebt'_def by auto
hence "summary = summary'"
using case4(2) sprop1 by blast
then show ?case
using ‹treeList = treeList'› infsplit sprop1 by fastforce
next
case (5 treeList n summary m deg mi ma)
note case4= this
hence "set_vebt' (Node (Some (mi, ma)) deg treeList summary) = set_vebt' s" by simp
hence a0:"deg ≥ 2" using 5
by (metis Suc_leI add_le_mono diff_Suc_1 less_add_same_cancel1 not_add_less1 not_less_iff_gr_or_eq numeral_2_eq_2 plus_1_eq_Suc set_n_deg_not_0)
hence aa:"{mi, ma} ⊆ set_vebt' (Node (Some (mi, ma)) deg treeList summary)"
apply auto using vebt_member.simps(5)[of mi ma "deg -2" treeList summary mi]
apply (metis add_2_eq_Suc' le_add_diff_inverse2 mem_Collect_eq set_vebt'_def)
using vebt_member.simps(5)[of mi ma "deg -2" treeList summary ma]
apply (metis add_2_eq_Suc' le_add_diff_inverse2 mem_Collect_eq set_vebt'_def)
done
from 5(12) obtain treeList' summary' info where sprop1:"s = Node info deg treeList' summary' ∧ deg = n+m
∧ length treeList' =2^m ∧ invar_vebt summary' m ∧ (∀ t ∈ set treeList'. invar_vebt t n) "
apply cases
using a0 apply linarith
apply (metis case4(5) case4(6) even_Suc odd_add add_self_div_2)
apply (metis Suc_inject add_Suc_right add_self_div_2 case4(5) case4(6))
apply (metis case4(5) case4(6) even_Suc odd_add)
apply (metis Suc_inject add_Suc_right add_self_div_2 case4(5) case4(6))
done
have ac:"invar_vebt t h ⟹ invar_vebt k h ⟹ set_vebt' t = set_vebt' k ⟹ vebt_mint t = vebt_mint k" for t k h
proof-
assume assms: "invar_vebt t h" "invar_vebt k h" "set_vebt' t = set_vebt' k"
have "¬ vebt_mint t = vebt_mint k ⟹ False"
proof-
assume "vebt_mint t ≠ vebt_mint k"
then obtain a b where abdef:"vebt_mint t = None ∧ vebt_mint k = Some b ∨
vebt_mint t = Some a ∧ vebt_mint k = None ∨
a < b ∧ Some a = vebt_mint t ∧ Some b = vebt_mint k ∨
b < a ∧ Some a = vebt_mint t ∧ Some b = vebt_mint k"
by (metis linorder_neqE_nat option.exhaust)
show False apply(cases "vebt_mint t = None ∧ vebt_mint k = Some b")
apply (metis ‹vebt_mint t ≠ vebt_mint k› assms(1) assms(2) assms(3) mint_corr mint_sound)
apply(cases " vebt_mint t = Some a ∧ vebt_mint k = None")
apply (metis ‹vebt_mint t ≠ vebt_mint k› assms(1) assms(2) assms(3) mint_corr mint_sound)
apply (cases "a < b ∧ Some a = vebt_mint t ∧ Some b = vebt_mint k")
apply (metis ‹vebt_mint t ≠ vebt_mint k› assms(1) assms(2) assms(3) mint_corr mint_sound)
by (metis ‹vebt_mint t ≠ vebt_mint k› abdef assms(1) assms(2) assms(3) mint_corr mint_sound)
qed
thus "vebt_mint t = vebt_mint k" by auto
qed
have ad:"invar_vebt t h ⟹ invar_vebt k h ⟹ set_vebt' t = set_vebt' k ⟹ vebt_maxt t = vebt_maxt k" for t k h
proof-
assume assms: "invar_vebt t h" "invar_vebt k h" "set_vebt' t = set_vebt' k"
have "¬ vebt_maxt t = vebt_maxt k ⟹ False"
proof-
assume "vebt_maxt t ≠ vebt_maxt k"
then obtain a b where abdef:"vebt_maxt t = None ∧ vebt_maxt k = Some b ∨
vebt_maxt t = Some a ∧ vebt_maxt k = None ∨
a < b ∧ Some a = vebt_maxt t ∧ Some b = vebt_maxt k ∨
b < a ∧ Some a = vebt_maxt t ∧ Some b = vebt_maxt k"
by (metis linorder_neqE_nat option.exhaust)
show False
apply(cases "vebt_maxt t = None ∧ vebt_maxt k = Some b")
apply (metis ‹vebt_maxt t ≠ vebt_maxt k› assms(1) assms(2) assms(3) maxt_corr maxt_sound)
apply(cases " vebt_maxt t = Some a ∧ vebt_maxt k = None")
apply (metis ‹vebt_maxt t ≠ vebt_maxt k› assms(1) assms(2) assms(3) maxt_corr maxt_sound)
apply (cases "a < b ∧ Some a = vebt_maxt t ∧ Some b = vebt_maxt k")
apply (metis ‹vebt_maxt t ≠ vebt_maxt k› assms(1) assms(2) assms(3) maxt_corr maxt_sound)
apply (metis ‹vebt_maxt t ≠ vebt_maxt k› abdef assms(1) assms(2) assms(3) maxt_corr maxt_sound)
done
qed
thus "vebt_maxt t = vebt_maxt k" by auto
qed
have infsplit: "info = Some (mi ,ma)" using 5(12)
proof cases
case (1 a b)
then show ?thesis
using sprop1 by blast
next
case (2 treeList n summary m)
then show ?thesis
by (metis "5.prems"(2) Collect_empty_eq VEBT_Member.vebt_member.simps(2) aa empty_iff insert_subset set_vebt'_def)
next
case (3 treeList n summary m)
then show ?thesis
by (metis "5.prems"(2) Collect_empty_eq VEBT_Member.vebt_member.simps(2) aa empty_iff insert_subset set_vebt'_def)
next
case (4 treeList' n' summary' m' mi' ma')
have "vebt_mint s = Some mi'"
by (simp add: "4"(1))
hence "mi' = mi"
by (smt (verit, ccfv_threshold) "5.hyps"(7) "5.prems"(1) "5.prems"(2) VEBT_Member.vebt_member.simps(5) One_nat_def a0 aa add.assoc eq_iff insert_subset leI le_add_diff_inverse less_imp_le_nat mem_Collect_eq min_in_set_def mint_sound numeral_2_eq_2 option.sel order.not_eq_order_implies_strict plus_1_eq_Suc set_vebt'_def)
have "vebt_maxt s = Some ma'"
by (simp add: "4"(1))
hence "ma' < ma ⟹ ma∉ set_vebt' s"
by (meson "5.prems"(1) leD max_in_set_def maxt_corr)
moreover have "ma < ma' ⟹ ma' ∉ set_vebt' (Node (Some (mi, ma)) deg treeList summary)" using case4
by (metis dual_order.strict_trans2 mem_Collect_eq member_inv not_less_iff_gr_or_eq set_vebt'_def)
ultimately have "ma'=ma"
by (metis ‹vebt_maxt s = Some ma'› aa case4(12) case4(13) insert_subset max_in_set_def maxt_corr not_less_iff_gr_or_eq)
then show ?thesis
using "4"(1) ‹mi' = mi› sprop1 by force
next
case (5 treeList' n' summary' m' mi' ma')
have "vebt_mint s = Some mi'"
by (simp add: "5"(1))
hence "mi' = mi"
by (smt (verit, ccfv_threshold) "5.hyps"(7) "5.prems"(1) "5.prems"(2) VEBT_Member.vebt_member.simps(5) One_nat_def a0 aa add.assoc eq_iff insert_subset leI le_add_diff_inverse less_imp_le_nat mem_Collect_eq min_in_set_def mint_sound numeral_2_eq_2 option.sel order.not_eq_order_implies_strict plus_1_eq_Suc set_vebt'_def)
have "vebt_maxt s = Some ma'"
by (simp add: "5"(1))
hence "ma' < ma ⟹ ma∉ set_vebt' s"
by (meson "5.prems"(1) leD max_in_set_def maxt_corr)
moreover have "ma < ma' ⟹ ma' ∉ set_vebt' (Node (Some (mi, ma)) deg treeList summary)" using case4
by (metis dual_order.strict_trans2 mem_Collect_eq member_inv not_less_iff_gr_or_eq set_vebt'_def)
ultimately have "ma'=ma" using case4(13) 5
by (metis ‹vebt_maxt s = Some ma'› aa both_member_options_equiv_member case4(12) insert_subset maxbmo mem_Collect_eq not_less_iff_gr_or_eq set_vebt'_def)
then show ?thesis
using "5"(1) ‹mi' = mi› sprop1 by force
qed
from 5(12) have acd:"mi ≠ ma ⟶
(∀i<2 ^ m.
(high ma n = i ⟶ both_member_options (treeList' ! i) (low ma n)) ∧
(∀x. high x n = i ∧ both_member_options (treeList' ! i) (low x n) ⟶ mi < x ∧ x ≤ ma))"
apply cases using sprop1 apply simp
using sprop1 infsplit apply simp
using sprop1 infsplit apply simp
apply (metis case4(5) even_Suc odd_add sprop1)
apply (smt (z3) Suc_inject VEBT.inject(1) add_Suc_right add_self_div_2 case4(5) infsplit option.inject prod.inject sprop1)
done
hence "length treeList' = 2^m"
using sprop1 by fastforce
hence aca:"length treeList' =length treeList" using "5.hyps"(2)
by (simp add: "5.hyps"(2) sprop1)
from 5(12) have sumtreelistcong: " ∀i<2 ^ m. (∃x. both_member_options (treeList' ! i) x) = both_member_options summary' i"
apply cases
using a0 apply linarith
apply (metis VEBT.inject(1) nth_mem sprop1)
using infsplit sprop1 apply force
apply (metis VEBT.inject(1) sprop1)
using sprop1 apply auto
done
hence membercongy:"i < 2^m ⟹ vebt_member (treeList! i) x ⟷ vebt_member (treeList' ! i) x" for i x
proof-
assume "i < 2^m"
show "vebt_member (treeList! i) x ⟷ vebt_member (treeList' ! i) x"
proof
show "vebt_member (treeList ! i) x ⟹ vebt_member (treeList' ! i) x"
proof-
assume "vebt_member (treeList ! i) x"
hence aaa:"both_member_options (treeList ! i) x"
by (metis ‹i < 2 ^ m› both_member_options_equiv_member case4(1) case4(4) nth_mem)
have "x < 2^n"
by (metis ‹i < 2 ^ m› ‹vebt_member (treeList ! i) x› case4(1) case4(4) member_bound nth_mem)
hence "both_member_options (Node (Some (mi, ma)) deg treeList summary) (2^n*i+x)"
using both_member_options_from_chilf_to_complete_tree
[of " (2^n*i+x)" deg treeList mi ma summary] aaa high_inv[of x n i]
‹i < 2 ^ m› ‹vebt_member (treeList ! i) x› low_inv[of x n i]
by (simp add: case4(4) case4(5) mult.commute sprop1)
hence "vebt_member (Node (Some (mi, ma)) deg treeList summary) (2^n*i+x)" using
valid_member_both_member_options[of "(Node (Some (mi, ma)) deg treeList summary)" deg "2^n*i+x"]
invar_vebt.intros(5)[of treeList n summary m deg mi ma] case4 by fastforce
hence "mi < (2^n*i+x) ∧ (2^n*i+x) ≤ ma" using vebt_mint.simps(3)[of mi ma deg treeList summary]
by (metis ‹i < 2 ^ m› ‹x < 2 ^ n› aaa case4(11) case4(4) case4(8) high_inv low_inv mult.commute nth_mem)
moreover have "both_member_options s (2^n*i +x)"
using ‹vebt_member (Node (Some (mi, ma)) deg treeList summary) (2 ^ n * i + x)› both_member_options_equiv_member case4(12) case4(13) case4(5) set_vebt'_def by auto
have acffs:"both_member_options (treeList' ! (high ma n)) (low ma n)"
using acd calculation case4(10) high_bound_aux sprop1 verit_comp_simplify1(3) by blast
hence "both_member_options (treeList' ! i) x"
using both_member_options_from_complete_tree_to_child[of deg mi ma treeList' summary' "2^n*i+x"]
low_inv[of x n i] high_inv[of x n i]
by (smt (z3) Nat.add_0_right ‹vebt_member (Node (Some (mi, ma)) deg treeList summary) (2 ^ n * i + x)› ‹x < 2 ^ n› a0 add_Suc_right add_leD1 both_member_options_equiv_member calculation case4(12) case4(13) case4(5) diff_Suc_1 div_less div_mult_self4 infsplit le_add_diff_inverse2 mem_Collect_eq mult.commute mult_2 nat_1_add_1 nat_neq_iff one_less_numeral_iff semiring_norm(76) sprop1 set_vebt'_def zero_neq_numeral)
then show "vebt_member (treeList' ! i) x"
by (metis ‹i < 2 ^ m› nth_mem sprop1 valid_member_both_member_options)
qed
show "vebt_member (treeList' ! i) x ⟹ vebt_member (treeList ! i) x"
proof-
assume "vebt_member (treeList' ! i) x"
hence "vebt_member s (2^n*i +x)" using sprop1 both_member_options_from_chilf_to_complete_tree
[of "(2^n*i +x)" deg treeList' mi ma summary']
by (smt (z3) Nat.add_0_right Suc_leD ‹i < 2 ^ m› a0 add_Suc_right both_member_options_equiv_member case4(12) case4(5) diff_Suc_1 div_less div_mult_self4 even_Suc high_def infsplit low_inv member_bound mult.commute mult_2_right nat_1_add_1 nth_mem odd_add odd_two_times_div_two_nat plus_1_eq_Suc power_not_zero zero_neq_numeral)
hence "mi < (2^n*i +x) ∧ (2^n*i +x) ≤ ma "
using vebt_mint.simps(3)[of mi ma deg treeList' summary'] vebt_maxt.simps(3)[of mi ma deg treeList' summary']
by (metis ‹i < 2 ^ m› ‹vebt_member (treeList' ! i) x› acd both_member_options_equiv_member case4(12) high_inv infsplit low_inv member_bound mi_eq_ma_no_ch mult.commute nth_mem sprop1)
moreover have "both_member_options (Node (Some (mi, ma)) deg treeList summary) (2^n*i +x)"
by (metis ‹vebt_member s (2 ^ n * i + x)› add_leD1 both_member_options_equiv_member both_member_options_from_chilf_to_complete_tree calculation case4(1) case4(13) case4(5) maxbmo vebt_maxt.simps(3) mem_Collect_eq member_inv nat_neq_iff nth_mem one_add_one set_vebt'_def)
have "invar_vebt (treeList' ! i) n"
by (simp add: ‹i < 2 ^ m› sprop1)
hence "x < 2^n"
using ‹vebt_member (treeList' ! i) x› member_bound by auto
hence "both_member_options (treeList ! i) x"
using both_member_options_from_complete_tree_to_child[of deg mi ma treeList summary "(2^n*i +x)"]
low_inv[of x n i] high_inv[of x n i]
by (smt (z3) Nat.add_0_right Suc_leD ‹both_member_options (Node (Some (mi, ma)) deg treeList summary) (2 ^ n * i + x)› ‹i < 2 ^ m› a0 add_Suc_right calculation case4(11) case4(5) div_less div_mult_self4 mult.commute mult_2 nat_1_add_1 nat_neq_iff one_less_numeral_iff plus_1_eq_Suc semiring_norm(76) sprop1 zero_neq_numeral)
then show ?thesis
by (metis ‹i < 2 ^ m› aca case4(1) nth_mem sprop1 valid_member_both_member_options)
qed
qed
qed
hence setcongy: "i < 2^m ⟹ set_vebt' (treeList ! i) = set_vebt' (treeList' ! i)" for i unfolding set_vebt'_def by presburger
hence treecongy: "i < 2^m ⟹ treeList ! i = treeList' ! i" for i
by (metis case4(1) case4(4) nth_mem sprop1)
hence "treeList = treeList'"
by (metis aca case4(4) nth_equalityI)
have "vebt_member summary x ⟷ vebt_member summary' x" for x
by (metis ‹treeList = treeList'› both_member_options_equiv_member case4(3) case4(7) member_bound sprop1 sumtreelistcong)
hence "set_vebt' summary = set_vebt' summary'" unfolding set_vebt'_def by auto
hence "summary = summary'"
using case4(2) sprop1 by blast
then show ?case
using ‹treeList = treeList'› infsplit sprop1 by fastforce
qed
corollary "invar_vebt t n ⟹ set_vebt' t = {} ⟹ t = vebt_buildup n"
by (metis buildup_gives_empty buildup_gives_valid deg_not_0 uniquetree)
corollary unique_tree: "invar_vebt t n ⟹ invar_vebt s n ⟹ set_vebt t = set_vebt s ⟹ s = t"
by (simp add: set_vebt_set_vebt'_valid uniquetree)
corollary "invar_vebt t n ⟹ set_vebt t = {} ⟹ t = vebt_buildup n"
by (metis buildup_gives_empty buildup_gives_valid deg_not_0 uniquetree set_vebt_set_vebt'_valid)
text ‹All valid trees can be generated by $vebt-insertion$ chains on an empty tree with same degree parameter:›
inductive perInsTrans::"VEBT ⇒ VEBT ⇒ bool" where
"perInsTrans t t"|
"(t = vebt_insert s x) ⟹ perInsTrans t u ⟹ perInsTrans s u"
lemma perIT_concat:" perInsTrans s t ⟹ perInsTrans t u ⟹ perInsTrans s u"
by (induction s t rule: perInsTrans.induct) (simp add: perInsTrans.intros)+
lemma assumes "invar_vebt t n " shows
"perInsTrans (vebt_buildup n) t"
proof-
have "finite A ⟹invar_vebt s n ⟹set_vebt' s = B ⟹ B⊆ A ⟹ perInsTrans (vebt_buildup n) s" for s A B
proof (induction "card B" arbitrary: s B)
case 0
then show ?case
by (metis buildup_gives_empty buildup_gives_valid card_eq_0_iff deg_not_0 perInsTrans.intros(1) set_vebt_finite uniquetree)
next
case (Suc car)
hence "finite B"
by (meson rev_finite_subset)
obtain x b where "B = insert x b ∧ x ∉ b"
by (metis Suc.hyps(2) card_Suc_eq)
have "set_vebt' (vebt_delete s x) = b"
using Suc.prems(2) Suc.prems(3) ‹B = insert x b ∧ x ∉ b› delete_correct' by auto
moreover hence "perInsTrans (vebt_buildup n) (vebt_delete s x)"
by (metis Suc.hyps(1) Suc.hyps(2) Suc.prems(1) Suc.prems(2) Suc.prems(4) ‹B = insert x b ∧ x ∉ b› ‹finite B› card_insert_disjoint delete_pres_valid finite_insert nat.inject subset_insertI subset_trans)
hence "set_vebt' (vebt_insert (vebt_delete s x) x) = set_vebt' s"
by (metis Diff_insert_absorb Suc.prems(2) Suc.prems(3) Un_insert_right ‹B = insert x b ∧ x ∉ b› boolean_algebra_cancel.sup0 delete_pres_valid delete_correct' insertI1 insert_corr mem_Collect_eq member_bound set_vebt'_def)
have "invar_vebt (vebt_insert (vebt_delete s x) x) n"
by (metis Suc.prems(2) Suc.prems(3) ‹B = insert x b ∧ x ∉ b› delete_pres_valid insertI1 mem_Collect_eq member_bound set_vebt'_def valid_pres_insert)
moreover hence "vebt_insert (vebt_delete s x) x = s"
using Suc.prems(2) ‹set_vebt' (VEBT_Insert.vebt_insert (vebt_delete s x) x) = set_vebt' s› uniquetree by force
ultimately show ?case
by (metis ‹perInsTrans (vebt_buildup n) (vebt_delete s x)› perIT_concat perInsTrans.intros(1) perInsTrans.intros(2))
qed
then show ?thesis
by (meson assms equalityD1 set_vebt_finite)
qed
end
end
Theory VEBT_Height
theory VEBT_Height imports VEBT_Definitions Complex_Main
begin
context VEBT_internal begin
section ‹Heights of van Emde Boas Trees›
fun height::"VEBT ⇒ nat" where
"height (Leaf a b) = 0"|
"height (Node _ deg treeList summary) = (1+ Max (height ` (insert summary (set treeList))))"
abbreviation "lb x ≡ log 2 x"
lemma setceilmax: "invar_vebt s m ⟹∀ t ∈ set listy. invar_vebt t n
⟹m = Suc n ⟹(∀ t ∈ set listy. height t = ⌈lb n ⌉ ) ⟹ height s = ⌈lb m⌉
⟹ Max (height ` (insert s (set listy))) = ⌈lb m⌉"
proof(induction listy)
case Nil
hence "Max (height ` (insert s(set []))) = height s" by simp
then show ?case using Nil by simp
next
case (Cons a list)
have "Max (height ` insert s (set (a # list))) =
max (height a) (Max (height ` insert s (set ( list))))"
by (simp add: insert_commute)
moreover have "max (height a) (Max (height ` insert s (set ( list)))) = max (height a) ⌈lb m ⌉"
using Cons insert_iff list.simps(15) max_def of_nat_max by force
moreover have " ∀ t ∈ set (a#list). invar_vebt t n " using Cons by simp
moreover hence "invar_vebt a n" by simp
hence "m ≥ n"
by (simp add: Cons.prems(3))
hence "lb m ≥ lb n"
using deg_not_0 ‹invar_vebt a n› by fastforce
hence "⌈ lb m⌉ ≥ ⌈ lb n⌉"
by (simp add: ceiling_mono)
moreover hence " max ⌈log 2 n ⌉ ⌈log 2 m ⌉ = ⌈log 2 m ⌉" by simp
ultimately show ?case
using Cons.prems(4) ‹invar_vebt a n›
by (metis list.set_intros(1))
qed
lemma log_ceil_idem:
assumes"(x::real) ≥ 1"
shows "⌈lb x ⌉ = ⌈lb ⌈x⌉⌉"
proof-
have "⌈log 2 x ⌉ ≥ 0"
by (smt (verit, ccfv_SIG) assms zero_le_ceiling zero_le_log_cancel_iff)
have " ⌈log 2 x ⌉ -1 < log 2 x ∧log 2 x ≤ ⌈log 2 x ⌉"
by linarith
moreover hence "2 powr (⌈log 2 x ⌉ -1) < x ∧ x ≤ 2 powr ( ⌈log 2 x ⌉)"
by (smt (verit, ccfv_SIG) assms less_log_iff real_nat_ceiling_ge)
moreover hence "2 powr ((⌈log 2 x ⌉ -1)) < ⌈x⌉" and " ⌈x⌉ ≤ 2 powr (⌈log 2 x ⌉)"
apply linarith
using ‹0 ≤ ⌈log 2 x⌉› calculation(2) ceiling_mono powr_int by fastforce
moreover hence " ⌈log 2 x ⌉ -1 < log 2 ⌈ x ⌉ ∧log 2 ⌈x⌉ ≤ ⌈log 2 x ⌉"
by (smt (verit, best) assms ceiling_correct less_log_iff)
ultimately show ?thesis
by linarith
qed
lemma heigt_uplog_rel:"invar_vebt t n ⟹ (height t) = ⌈lb n⌉"
proof(induction t n rule: invar_vebt.induct)
case (1 a b)
then show ?case by simp
next
case (2 treeList n summary m deg)
hence "m ≥ n" by simp
hence "log 2 m ≥ log 2 n"
by (simp add: "2.hyps"(3))
hence "⌈ log 2 m⌉ ≥ ⌈ log 2 n⌉"
by (simp add: "2.hyps"(3))
have "Max (height ` (insert summary (set treeList))) = ⌈ log 2 m⌉"
by (smt (verit, best) "2.IH"(1) "2.IH"(2) "2.hyps"(3) List.finite_set Max_in empty_is_image finite_imageI finite_insert image_iff insert_iff insert_not_empty)
hence "height (Node None deg treeList summary) = 1+ ⌈ log 2 m⌉" by simp
moreover have "1+ ⌈ log 2 m⌉ = ⌈1+ log 2 m⌉" by linarith
moreover have "1+ log 2 m = log 2 (2*m)"
using "2.hyps"(1) deg_not_0 log_mult by force
moreover hence "⌈1+ log 2 m⌉ = ⌈log 2 (2*m)⌉" by simp
moreover hence " ⌈log 2 (2*m)⌉ = ⌈log 2 (n+m)⌉"
using "2.hyps"(3) by force
ultimately show ?case
using "2.hyps"(4) by metis
next
case (3 treeList n summary m deg)
hence 00: "n ≥ 1 ∧ Suc n = m"
using set_n_deg_not_0 by blast
hence 0:"m ≥ n"using 3 by simp
hence 1:"log 2 m ≥ log 2 n"
using "3.IH"(1) "3.hyps"(2) set_n_deg_not_0 by fastforce
hence 2:"⌈ log 2 m⌉ ≥ ⌈ log 2 n⌉"
by (simp add: ceiling_mono)
have 3: "Max (height ` (insert summary (set treeList))) = ⌈ log 2 m⌉"
using "3.IH"(1) "3.IH"(2) "3.hyps"(3) List.finite_set Max_in empty_is_image
finite_imageI finite_insert image_iff insert_iff insert_not_empty "3.hyps"(1) setceilmax by auto
hence 4:"height (Node None deg treeList summary) = 1+ ⌈ log 2 m⌉" by simp
have 5:"1+ ⌈ log 2 m⌉ = ⌈1+ log 2 m⌉" by linarith
have 6:"1+ log 2 m = log 2 (m+m)"
using "3.hyps"(1) deg_not_0 log_mult by force
hence 7:"log 2 (m+n) = 1+log 2 ((n+m) / 2) "
by (simp add: "3.hyps"(3) log_divide)
have 8:"log 2 ((n+m) / 2) = log 2 (n + 1/2)"
by (smt (verit, best) "3.hyps"(3) field_sum_of_halves of_nat_Suc of_nat_add)
have 9 : "⌈ log 2 (n + 1/2) ⌉ = ⌈ log 2 ⌈n + 1/2 ⌉ ⌉"
by (smt (verit) "00" field_sum_of_halves log_ceil_idem of_nat_1 of_nat_mono)
hence 10: " ⌈n + 1/2 ⌉ = m" using 00 by linarith
hence 11: "⌈ log 2 (n + 1/2) ⌉ = ⌈ log 2 m ⌉ " using 9 by simp
hence 12:"⌈ 1+ log 2 (n + 1/2) ⌉ = ⌈1+ log 2 m ⌉"
by (smt (verit) ceiling_add_one)
hence "⌈ log 2 (n + n+1) ⌉ = ⌈ log 2 (m+m) ⌉"
using "3.hyps"(3) "6" "7" "8" by force
then show ?case
by (metis "12" "3.hyps"(4) "4" "5" "7" "8" add.commute)
next
case (4 treeList n summary m deg mi ma)
hence "m ≥ n" by simp
hence "log 2 m ≥ log 2 n"
by (simp add: "4.hyps"(3))
hence "⌈ log 2 m⌉ ≥ ⌈ log 2 n⌉"
by (simp add: "4.hyps"(3))
have "Max (height ` (insert summary (set treeList))) = ⌈ log 2 m⌉"
by (smt (verit, best) "4.IH"(1) "4.IH"(2) "4.hyps"(3) List.finite_set Max_in empty_is_image finite_imageI finite_insert image_iff insert_iff insert_not_empty)
hence "height (Node None deg treeList summary) = 1+ ⌈ log 2 m⌉" by simp
moreover have "1+ ⌈ log 2 m⌉ = ⌈1+ log 2 m⌉" by linarith
moreover have "1+ log 2 m = log 2 (2*m)"
using "4.hyps"(1) deg_not_0 log_mult by force
moreover hence "⌈1+ log 2 m⌉ = ⌈log 2 (2*m)⌉" by simp
moreover hence " ⌈log 2 (2*m)⌉ = ⌈log 2 (n+m)⌉"
using "4.hyps"(3) by force
ultimately show ?case
by (metis "4.hyps"(4) height.simps(2))
next
case (5 treeList n summary m deg mi ma)
hence 00: "n ≥ 1 ∧ Suc n = m"
using set_n_deg_not_0 by blast
hence 0:"m ≥ n"using 5 by simp
hence 1:"log 2 m ≥ log 2 n"
using "5.IH"(1) "5.hyps"(2) set_n_deg_not_0 by fastforce
hence 2:"⌈ log 2 m⌉ ≥ ⌈ log 2 n⌉"
by (simp add: ceiling_mono)
have 3: "Max (height ` (insert summary (set treeList))) = ⌈ log 2 m⌉"
using "5.IH"(1) "5.IH"(2) "5.hyps"(3) List.finite_set Max_in empty_is_image
finite_imageI finite_insert image_iff insert_iff insert_not_empty "5.hyps"(1) setceilmax by auto
hence 4:"height (Node None deg treeList summary) = 1+ ⌈ log 2 m⌉" by simp
have 5:"1+ ⌈ log 2 m⌉ = ⌈1+ log 2 m⌉" by linarith
have 6:"1+ log 2 m = log 2 (m+m)"
using "5.hyps"(1) deg_not_0 log_mult by force
hence 7:"log 2 (m+n) = 1+log 2 ((n+m) / 2) "
by (simp add: "5.hyps"(3) log_divide)
have 8:"log 2 ((n+m) / 2) = log 2 (n + 1/2)"
by (smt (verit, best) "5.hyps"(3) field_sum_of_halves of_nat_Suc of_nat_add)
have 9 : "⌈ log 2 (n + 1/2) ⌉ = ⌈ log 2 ⌈n + 1/2 ⌉ ⌉"
by (smt (verit) "00" field_sum_of_halves log_ceil_idem of_nat_1 of_nat_mono)
hence 10: " ⌈n + 1/2 ⌉ = m" using 00 by linarith
hence 11: "⌈ log 2 (n + 1/2) ⌉ = ⌈ log 2 m ⌉ " using 9 by simp
hence 12:"⌈ 1+ log 2 (n + 1/2) ⌉ = ⌈1+ log 2 m ⌉"
by (smt (verit) ceiling_add_one)
hence "⌈ log 2 (n + n+1) ⌉ = ⌈ log 2 (m+m) ⌉"
using "5.hyps"(3) "6" "7" "8" by force
then show ?case
using "4" "5" "5.hyps"(3) "5.hyps"(4) "6" by force
qed
lemma two_powr_height_bound_deg:
assumes "invar_vebt t n "
shows " 2^(height t) ≤ 2*(n::nat)"
proof-
have " (height t) = ⌈ log 2 n⌉"
by (simp add: assms heigt_uplog_rel)
moreover have "⌈ log 2 n⌉ ≤ log 2 n +1" by simp
moreover hence "2 powr ⌈ log 2 n⌉ ≤ 2 powr (log 2 n +1)" by simp
moreover have " 2 powr (log 2 n +1) = 2 powr 1 * 2 powr (log 2 n)"
by (simp add: powr_add)
moreover hence " 2 powr (log 2 n +1) = 2 * n"
using assms deg_not_0 by force
ultimately show ?thesis
by (metis linorder_not_less not_one_le_zero of_int_0 of_int_less_iff of_int_numeral of_int_of_nat_eq of_nat_le_iff one_add_one order_less_le powr_realpow real_of_nat_eq_numeral_power_cancel_iff zle_add1_eq_le)
qed
text ‹Main Theorem›
theorem height_double_log_univ_size:
assumes "u = 2^deg" and "invar_vebt t deg "
shows "height t ≤ 1 + lb (lb u)"
proof-
have "(height t) = ⌈lb deg⌉"
by (simp add: assms(2) heigt_uplog_rel)
have "2^(height t) ≤ 2 * deg" using assms(2) two_powr_height_bound_deg[of t deg]
by (meson dual_order.eq_iff dual_order.trans self_le_ge2_pow)
hence "height t ≤ 1 + lb deg"
using ‹int (height t) = ⌈lb (real deg)⌉› by linarith
hence "height t ≤ 1 + lb (lb u)" using assms by simp
thus ?thesis by simp
qed
lemma height_compose_list: " t∈ set treeList ⟹
Max (height ` (insert summary (set treeList))) ≥ height t"
apply(induction treeList) apply simp
by (meson List.finite_set Max_ge finite_imageI finite_insert image_eqI subsetD subset_insertI)
lemma height_compose_child: " t∈ set treeList ⟹
height (Node info deg treeList summary) ≥ 1+ height t" by simp
lemma height_compose_summary: " height (Node info deg treeList summary) ≥ 1+ height summary" by simp
lemma height_i_max: " i < length x13 ⟹
height (x13 ! i) ≤ max foo (Max (height ` set x13))"
by (meson List.finite_set Max_ge finite_imageI max.coboundedI2 nth_mem rev_image_eqI)
lemma max_ins_scaled: " n* height x14 ≤ m + n* Max (insert (height x14) (height ` set x13))"
by (meson List.finite_set Max_ge finite_imageI finite_insert insertI1 mult_le_mono2 trans_le_add2)
lemma max_idx_list:
assumes "i < length x13 "
shows " n * height (x13 !i) ≤ Suc (Suc (n * max (height x14) (Max (height ` set x13))))"
by (metis assms height_i_max less_Suc_eq mult_le_mono2 nat_less_le)
end
end
Theory VEBT_Bounds
theory VEBT_Bounds imports VEBT_Height VEBT_Member VEBT_Insert VEBT_Succ VEBT_Pred
begin
section ‹Upper Bounds for canonical Functions: Relationships between Run Time and Tree Heights›
subsection ‹Membership test›
context begin
interpretation VEBT_internal .
fun T⇩m⇩e⇩m⇩b⇩e⇩r::"VEBT ⇒ nat ⇒ nat" where
"T⇩m⇩e⇩m⇩b⇩e⇩r (Leaf a b) x = 2 + (if x = 0 then 1 else 1 +( if x=1 then 1 else 1))"|
"T⇩m⇩e⇩m⇩b⇩e⇩r (Node None _ _ _) x = 2"|
"T⇩m⇩e⇩m⇩b⇩e⇩r (Node _ 0 _ _) x = 2"|
"T⇩m⇩e⇩m⇩b⇩e⇩r (Node _ (Suc 0) _ _) x = 2"|
"T⇩m⇩e⇩m⇩b⇩e⇩r (Node (Some (mi, ma)) deg treeList summary) x = 2 + (
if x = mi then 1 else 1+ (
if x = ma then 1 else 1+(
if x < mi then 1 else 1+ (
if x > ma then 1 else 9 +
(let
h = high x (deg div 2);
l = low x (deg div 2) in
(if h < length treeList
then 1 + T⇩m⇩e⇩m⇩b⇩e⇩r (treeList ! h) l
else 1))))))"
fun T⇩m⇩e⇩m⇩b⇩e⇩r'::"VEBT ⇒ nat ⇒ nat" where
"T⇩m⇩e⇩m⇩b⇩e⇩r' (Leaf a b) x = 1"|
"T⇩m⇩e⇩m⇩b⇩e⇩r' (Node None _ _ _) x = 1"|
"T⇩m⇩e⇩m⇩b⇩e⇩r' (Node _ 0 _ _) x = 1"|
"T⇩m⇩e⇩m⇩b⇩e⇩r' (Node _ (Suc 0) _ _) x = 1"|
"T⇩m⇩e⇩m⇩b⇩e⇩r' (Node (Some (mi, ma)) deg treeList summary) x = 1+(
if x = mi then 0 else (
if x = ma then 0 else (
if x < mi then 0 else (
if x > ma then 0 else if (x>mi ∧ x < ma) then
(let
h = high x (deg div 2);
l = low x (deg div 2) in
(if h < length treeList
then T⇩m⇩e⇩m⇩b⇩e⇩r' (treeList ! h) l
else 0))
else 0))))"
lemma height_node: "invar_vebt (Node (Some (mi, ma)) deg treeList summary) n
⟹ height (Node (Some (mi, ma)) deg treeList summary) >= 1"
using height.simps(2) by presburger
theorem member_bound_height: "invar_vebt t n ⟹ T⇩m⇩e⇩m⇩b⇩e⇩r t x ≤ (1+height t)*15"
proof(induction t n arbitrary: x rule: invar_vebt.induct)
case (1 a b)
then show ?case by simp
next
case (2 treeList n summary m deg)
then show ?case by simp
next
case (3 treeList n summary m deg)
then show ?case by simp
next
case (4 treeList n summary m deg mi ma)
hence "n ≥ 1 ∧ m ≥ 1"
by (metis Nat.add_0_right Suc_leI deg_not_0 plus_1_eq_Suc)
hence "deg ≥ 2"
by (simp add: "4.hyps"(4))
then show ?case
proof(cases "x = mi")
case True
hence "T⇩m⇩e⇩m⇩b⇩e⇩r (Node (Some (mi, ma)) deg treeList summary) x = 3"
using T⇩m⇩e⇩m⇩b⇩e⇩r.simps(5)[of mi ma "deg -2" treeList summary x]
by (smt (z3) Suc_1 Suc_diff_le Suc_eq_plus1 Suc_leD ‹2 ≤ deg› diff_Suc_1 diff_Suc_Suc eval_nat_numeral(3))
then show ?thesis by simp
next
case False
hence "x ≠ mi" by simp
hence 1:"T⇩m⇩e⇩m⇩b⇩e⇩r (Node (Some (mi, ma)) deg treeList summary) x = 3 + (
if x = ma then 1 else 1+(
if x < mi then 1 else 1+ (
if x > ma then 1 else 9 +
(let h = high x (deg div 2); l = low x (deg div 2) in
(if h < length treeList
then 1 + T⇩m⇩e⇩m⇩b⇩e⇩r (treeList ! h) l
else 1)))))"
using T⇩m⇩e⇩m⇩b⇩e⇩r.simps(5)[of mi ma "deg -2" treeList summary x]
by (smt (z3) One_nat_def Suc_1 ‹2 ≤ deg› add_Suc_shift le_add_diff_inverse numeral_3_eq_3 plus_1_eq_Suc)
then show ?thesis
proof(cases "x = ma")
case True
hence "T⇩m⇩e⇩m⇩b⇩e⇩r (Node (Some (mi, ma)) deg treeList summary) x = 4" using 1 by auto
then show ?thesis by simp
next
case False
hence "x ≠ ma" by simp
hence 2:"T⇩m⇩e⇩m⇩b⇩e⇩r (Node (Some (mi, ma)) deg treeList summary) x = 4 +(
if x < mi then 1 else 1+ (
if x > ma then 1 else 9 +
(let
h = high x (deg div 2);
l = low x (deg div 2) in
(if h < length treeList
then 1 + T⇩m⇩e⇩m⇩b⇩e⇩r (treeList ! h) l
else 1))))"
using 1 by simp
then show ?thesis
proof(cases "x < mi")
case True
hence "T⇩m⇩e⇩m⇩b⇩e⇩r (Node (Some (mi, ma)) deg treeList summary) x = 5" using 2 by auto
then show ?thesis by simp
next
case False
hence "x > mi"
using ‹x ≠ mi› antisym_conv3 by blast
hence 3:"T⇩m⇩e⇩m⇩b⇩e⇩r (Node (Some (mi, ma)) deg treeList summary) x = 5 + (
if x > ma then 1 else 9 +
(let h = high x (deg div 2); l = low x (deg div 2) in
(if h < length treeList
then 1 + T⇩m⇩e⇩m⇩b⇩e⇩r (treeList ! h) l
else 1)))"
using 2 by simp
then show ?thesis
proof(cases "x > ma")
case True
hence "T⇩m⇩e⇩m⇩b⇩e⇩r (Node (Some (mi, ma)) deg treeList summary) x = 6" using 3 by simp
then show ?thesis by simp
next
case False
hence "x < ma"
by (meson ‹x ≠ ma› nat_neq_iff)
hence 4:"T⇩m⇩e⇩m⇩b⇩e⇩r (Node (Some (mi, ma)) deg treeList summary) x = 14+
(let h = high x (deg div 2); l = low x (deg div 2) in
(if h < length treeList
then 1 + T⇩m⇩e⇩m⇩b⇩e⇩r (treeList ! h) l
else 1))"
using 3 by simp
let ?h = "high x (deg div 2)"
let ?l = " low x (deg div 2)"
have "?h < length treeList"
using "4.hyps"(2) "4.hyps"(3) "4.hyps"(4) "4.hyps"(8) ‹x < ma› high_bound_aux by force
hence 5:"T⇩m⇩e⇩m⇩b⇩e⇩r (Node (Some (mi, ma)) deg treeList summary) x = 15 + T⇩m⇩e⇩m⇩b⇩e⇩r (treeList ! ?h) ?l"
using "4" by presburger
moreover have "invar_vebt (treeList ! ?h) n ∧ (treeList ! ?h) ∈ set treeList "
using "4.IH"(1) ‹high x (deg div 2) < length treeList› nth_mem by blast
moreover hence " T⇩m⇩e⇩m⇩b⇩e⇩r (treeList ! ?h) ?l ≤ (1 + height (treeList ! ?h))*15" using "4.IH"(1) by simp
ultimately have 6:"T⇩m⇩e⇩m⇩b⇩e⇩r (Node (Some (mi, ma)) deg treeList summary) x ≤
15 + 15 * (1 + height (treeList ! ?h))" by simp
moreover have "i< length treeList ⟹
height (treeList ! i) ≤ Max (height ` (insert summary (set treeList)))" for i
apply (induction treeList arbitrary: i)
apply simp
apply (meson List.finite_set Max_ge finite_imageI finite_insert image_iff nth_mem subsetD subset_insertI)
done
moreover hence " (1 + height (treeList ! ?h)) ≤ height (Node (Some (mi, ma)) deg treeList summary)"
by (simp add: ‹high x (deg div 2) < length treeList›)
moreover hence " 14 * (1 + height (treeList ! ?h)) ≤ 14 * height (Node (Some (mi, ma)) deg treeList summary)" by simp
ultimately show ?thesis using 6 algebra_simps add_mono_thms_linordered_semiring(2) mult.right_neutral order_trans by force
qed
qed
qed
qed
next
case (5 treeList n summary m deg mi ma)
hence "n ≥ 1 ∧ m ≥ 1"
by (metis le_add1 plus_1_eq_Suc set_n_deg_not_0)
hence "deg ≥ 2"
by (simp add: "5.hyps"(4))
then show ?case
proof(cases "x = mi")
case True
hence "T⇩m⇩e⇩m⇩b⇩e⇩r (Node (Some (mi, ma)) deg treeList summary) x = 3"
using T⇩m⇩e⇩m⇩b⇩e⇩r.simps(5)[of mi ma "deg -2" treeList summary x]
by (smt (z3) One_nat_def Suc_nat_number_of_add ‹2 ≤ deg› le_add_diff_inverse numeral_3_eq_3 numerals(1) plus_1_eq_Suc semiring_norm(2))
then show ?thesis by simp
next
case False
hence "x ≠ mi" by simp
hence 1:"T⇩m⇩e⇩m⇩b⇩e⇩r (Node (Some (mi, ma)) deg treeList summary) x = 3 + (
if x = ma then 1 else 1+(
if x < mi then 1 else 1+ (
if x > ma then 1 else 9 +
(let h = high x (deg div 2); l = low x (deg div 2) in
(if h < length treeList
then 1 + T⇩m⇩e⇩m⇩b⇩e⇩r (treeList ! h) l
else 1)))))"
using T⇩m⇩e⇩m⇩b⇩e⇩r.simps(5)[of mi ma "deg -2" treeList summary x]
by (smt (z3) One_nat_def Suc_1 ‹2 ≤ deg› add_Suc_shift le_add_diff_inverse numeral_3_eq_3 plus_1_eq_Suc)
then show ?thesis
proof(cases "x = ma")
case True
hence "T⇩m⇩e⇩m⇩b⇩e⇩r (Node (Some (mi, ma)) deg treeList summary) x = 4" using 1 by auto
then show ?thesis by simp
next
case False
hence "x ≠ ma" by simp
hence 2:"T⇩m⇩e⇩m⇩b⇩e⇩r (Node (Some (mi, ma)) deg treeList summary) x = 4 +(
if x < mi then 1 else 1+ (
if x > ma then 1 else 9 +
(let h = high x (deg div 2); l = low x (deg div 2) in
(if h < length treeList
then 1 + T⇩m⇩e⇩m⇩b⇩e⇩r (treeList ! h) l
else 1))))"
using 1 by simp
then show ?thesis
proof(cases "x < mi")
case True
hence "T⇩m⇩e⇩m⇩b⇩e⇩r (Node (Some (mi, ma)) deg treeList summary) x = 5" using 2 by auto
then show ?thesis by simp
next
case False
hence "x > mi"
using ‹x ≠ mi› antisym_conv3 by blast
hence 3:"T⇩m⇩e⇩m⇩b⇩e⇩r (Node (Some (mi, ma)) deg treeList summary) x = 5 + (
if x > ma then 1 else 9 +
(let h = high x (deg div 2); l = low x (deg div 2) in
(if h < length treeList then 1 + T⇩m⇩e⇩m⇩b⇩e⇩r (treeList ! h) l else 1)))"
using 2 by simp
then show ?thesis
proof(cases "x > ma")
case True
hence "T⇩m⇩e⇩m⇩b⇩e⇩r (Node (Some (mi, ma)) deg treeList summary) x = 6" using 3 by simp
then show ?thesis by simp
next
case False
hence "x < ma"
by (meson ‹x ≠ ma› nat_neq_iff)
hence 4:"T⇩m⇩e⇩m⇩b⇩e⇩r (Node (Some (mi, ma)) deg treeList summary) x = 14+
(let h = high x (deg div 2); l = low x (deg div 2) in
(if h < length treeList
then 1 + T⇩m⇩e⇩m⇩b⇩e⇩r (treeList ! h) l
else 1))"
using 3 by simp
let ?h = "high x (deg div 2)"
let ?l = " low x (deg div 2)"
have "?h < length treeList"
by (metis "5.hyps"(2) "5.hyps"(3) "5.hyps"(4) "5.hyps"(8) ‹x < ma› add_Suc_right add_self_div_2 even_Suc_div_two high_bound_aux odd_add order.strict_trans)
hence 5:"T⇩m⇩e⇩m⇩b⇩e⇩r (Node (Some (mi, ma)) deg treeList summary) x = 15 + T⇩m⇩e⇩m⇩b⇩e⇩r (treeList ! ?h) ?l"
using "4" by presburger
moreover have "invar_vebt (treeList ! ?h) n ∧ (treeList ! ?h) ∈ set treeList "
using "5.IH"(1) ‹high x (deg div 2) < length treeList› nth_mem by blast
moreover hence " T⇩m⇩e⇩m⇩b⇩e⇩r (treeList ! ?h) ?l ≤ (1 + height (treeList ! ?h))*15" using "5.IH"(1) by simp
ultimately have 6:"T⇩m⇩e⇩m⇩b⇩e⇩r (Node (Some (mi, ma)) deg treeList summary) x ≤
15 + 15 * (1 + height (treeList ! ?h))"
by simp
moreover have "i< length treeList ⟹
height (treeList ! i) ≤ Max (height ` (insert summary (set treeList)))" for i
apply (induction treeList arbitrary: i)
apply simp
apply (meson List.finite_set Max_ge finite_imageI finite_insert image_iff nth_mem subsetD subset_insertI)
done
moreover hence " (1 + height (treeList ! ?h)) ≤ height (Node (Some (mi, ma)) deg treeList summary)"
by (simp add: ‹high x (deg div 2) < length treeList›)
moreover hence " 15 * (1 + height (treeList ! ?h)) ≤ 15 * height (Node (Some (mi, ma)) deg treeList summary)" by simp
ultimately show ?thesis using 6
algebra_simps add_mono_thms_linordered_semiring(2) mult.right_neutral order_trans by force
qed
qed
qed
qed
qed
theorem member_bound_height': "invar_vebt t n ⟹ T⇩m⇩e⇩m⇩b⇩e⇩r' t x ≤ (1+height t)"
proof(induction t n arbitrary: x rule: invar_vebt.induct)
case (4 treeList n summary m deg mi ma)
hence "n ≥ 1 ∧ m ≥ 1"
by (metis Nat.add_0_right Suc_leI deg_not_0 plus_1_eq_Suc)
hence "deg ≥ 2"
by (simp add: "4.hyps"(4))
then show ?case
proof(cases "x = mi")
case True
hence "T⇩m⇩e⇩m⇩b⇩e⇩r' (Node (Some (mi, ma)) deg treeList summary) x = 1"
using T⇩m⇩e⇩m⇩b⇩e⇩r'.simps(5)[of mi ma "deg -2" treeList summary x]
by (smt (z3) One_nat_def ‹2 ≤ deg› add_2_eq_Suc ordered_cancel_comm_monoid_diff_class.add_diff_inverse plus_1_eq_Suc)
then show ?thesis by simp
next
case False
hence "x ≠ mi" by simp
hence 1:"T⇩m⇩e⇩m⇩b⇩e⇩r' (Node (Some (mi, ma)) deg treeList summary) x = 1 + (
if x = ma then 0 else (
if x < mi then 0 else (
if x > ma then 0 else
(let h = high x (deg div 2); l = low x (deg div 2) in
(if h < length treeList
then T⇩m⇩e⇩m⇩b⇩e⇩r' (treeList ! h) l
else 0)))))"
using T⇩m⇩e⇩m⇩b⇩e⇩r'.simps(5)[of mi ma "deg -2" treeList summary x]
by (smt (z3) ‹2 ≤ deg› add_2_eq_Suc le_add_diff_inverse linorder_not_less nat_less_le)
then show ?thesis
proof(cases "x = ma")
case True
hence "T⇩m⇩e⇩m⇩b⇩e⇩r' (Node (Some (mi, ma)) deg treeList summary) x = 1" using 1 by auto
then show ?thesis by simp
next
case False
hence "x ≠ ma" by simp
hence 2:"T⇩m⇩e⇩m⇩b⇩e⇩r' (Node (Some (mi, ma)) deg treeList summary) x = 1 +(
if x < mi then 0 else (
if x > ma then 0 else
(let h = high x (deg div 2); l = low x (deg div 2) in
(if h < length treeList
then T⇩m⇩e⇩m⇩b⇩e⇩r' (treeList ! h) l
else 0))))"
using 1 by simp
then show ?thesis
proof(cases "x < mi")
case True
hence "T⇩m⇩e⇩m⇩b⇩e⇩r' (Node (Some (mi, ma)) deg treeList summary) x = 1" using 2 by auto
then show ?thesis by simp
next
case False
hence "x > mi"
using ‹x ≠ mi› antisym_conv3 by blast
hence 3:"T⇩m⇩e⇩m⇩b⇩e⇩r' (Node (Some (mi, ma)) deg treeList summary) x = 1 + (
if x > ma then 0 else
(let h = high x (deg div 2); l = low x (deg div 2) in
(if h < length treeList
then T⇩m⇩e⇩m⇩b⇩e⇩r' (treeList ! h) l
else 0)))"
using 2 by simp
then show ?thesis
proof(cases "x > ma")
case True
hence "T⇩m⇩e⇩m⇩b⇩e⇩r' (Node (Some (mi, ma)) deg treeList summary) x = 1" using 3 by simp
then show ?thesis by simp
next
case False
hence "x < ma"
by (meson ‹x ≠ ma› nat_neq_iff)
hence 4:"T⇩m⇩e⇩m⇩b⇩e⇩r' (Node (Some (mi, ma)) deg treeList summary) x = 1+
(let h = high x (deg div 2); l = low x (deg div 2) in
(if h < length treeList
then T⇩m⇩e⇩m⇩b⇩e⇩r' (treeList ! h) l
else 0))"
using 3 by simp
let ?h = "high x (deg div 2)"
let ?l = " low x (deg div 2)"
have "?h < length treeList"
using "4.hyps"(2) "4.hyps"(3) "4.hyps"(4) "4.hyps"(8) ‹x < ma› high_bound_aux by force
hence 5:"T⇩m⇩e⇩m⇩b⇩e⇩r' (Node (Some (mi, ma)) deg treeList summary) x = 1+ T⇩m⇩e⇩m⇩b⇩e⇩r' (treeList ! ?h) ?l"
using "4" by presburger
moreover have "invar_vebt (treeList ! ?h) n ∧ (treeList ! ?h) ∈ set treeList "
using "4.IH"(1) ‹high x (deg div 2) < length treeList› nth_mem by blast
moreover hence " T⇩m⇩e⇩m⇩b⇩e⇩r' (treeList ! ?h) ?l ≤ (1 + height (treeList ! ?h))*1" using "4.IH"(1) by simp
ultimately have 6:"T⇩m⇩e⇩m⇩b⇩e⇩r' (Node (Some (mi, ma)) deg treeList summary) x ≤
1 + (1 + height (treeList ! ?h))" by simp
moreover have "i< length treeList ⟹
height (treeList ! i) ≤ Max (height ` (insert summary (set treeList)))" for i
apply (induction treeList arbitrary: i)
apply simp
apply (meson List.finite_set Max_ge finite_imageI finite_insert image_iff nth_mem subsetD subset_insertI)
done
moreover hence " (1 + height (treeList ! ?h)) ≤ height (Node (Some (mi, ma)) deg treeList summary)"
by (simp add: ‹high x (deg div 2) < length treeList›)
moreover hence " 14 * (1 + height (treeList ! ?h)) ≤ 14 * height (Node (Some (mi, ma)) deg treeList summary)" by simp
ultimately show ?thesis using 6 algebra_simps add_mono_thms_linordered_semiring(2) mult.right_neutral order_trans by force
qed
qed
qed
qed
next
case (5 treeList n summary m deg mi ma)
hence "n ≥ 1 ∧ m ≥ 1"
by (metis le_add1 plus_1_eq_Suc set_n_deg_not_0)
hence "deg ≥ 2"
by (simp add: "5.hyps"(4))
then show ?case
proof(cases "x = mi")
case True
hence "T⇩m⇩e⇩m⇩b⇩e⇩r' (Node (Some (mi, ma)) deg treeList summary) x = 1"
using T⇩m⇩e⇩m⇩b⇩e⇩r'.simps(5)[of mi ma "deg -2" treeList summary x]
by (smt (z3) One_nat_def ‹2 ≤ deg› add_2_eq_Suc ordered_cancel_comm_monoid_diff_class.add_diff_inverse plus_1_eq_Suc)
then show ?thesis by simp
next
case False
hence "x ≠ mi" by simp
hence 1:"T⇩m⇩e⇩m⇩b⇩e⇩r' (Node (Some (mi, ma)) deg treeList summary) x = 1 + (
if x = ma then 0 else (
if x < mi then 0 else (
if x > ma then 0 else
(let h = high x (deg div 2); l = low x (deg div 2) in
(if h < length treeList
then T⇩m⇩e⇩m⇩b⇩e⇩r' (treeList ! h) l
else 0)))))"
using T⇩m⇩e⇩m⇩b⇩e⇩r'.simps(5)[of mi ma "deg -2" treeList summary x]
by (smt (z3) ‹2 ≤ deg› add_2_eq_Suc le_add_diff_inverse linorder_not_less nat_less_le)
then show ?thesis
proof(cases "x = ma")
case True
hence "T⇩m⇩e⇩m⇩b⇩e⇩r' (Node (Some (mi, ma)) deg treeList summary) x = 1" using 1 by auto
then show ?thesis by simp
next
case False
hence "x ≠ ma" by simp
hence 2:"T⇩m⇩e⇩m⇩b⇩e⇩r' (Node (Some (mi, ma)) deg treeList summary) x = 1 +(
if x < mi then 0 else (
if x > ma then 0 else
(let h = high x (deg div 2); l = low x (deg div 2) in
(if h < length treeList
then T⇩m⇩e⇩m⇩b⇩e⇩r' (treeList ! h) l
else 0))))"
using 1 by simp
then show ?thesis
proof(cases "x < mi")
case True
hence "T⇩m⇩e⇩m⇩b⇩e⇩r' (Node (Some (mi, ma)) deg treeList summary) x = 1" using 2 by auto
then show ?thesis by simp
next
case False
hence "x > mi"
using ‹x ≠ mi› antisym_conv3 by blast
hence 3:"T⇩m⇩e⇩m⇩b⇩e⇩r' (Node (Some (mi, ma)) deg treeList summary) x = 1 + (
if x > ma then 0 else
(let h = high x (deg div 2); l = low x (deg div 2) in
(if h < length treeList
then T⇩m⇩e⇩m⇩b⇩e⇩r' (treeList ! h) l
else 0)))"
using 2 by simp
then show ?thesis
proof(cases "x > ma")
case True
hence "T⇩m⇩e⇩m⇩b⇩e⇩r' (Node (Some (mi, ma)) deg treeList summary) x = 1" using 3 by simp
then show ?thesis by simp
next
case False
hence "x < ma"
by (meson ‹x ≠ ma› nat_neq_iff)
hence 4:"T⇩m⇩e⇩m⇩b⇩e⇩r' (Node (Some (mi, ma)) deg treeList summary) x = 1+
(let h = high x (deg div 2); l = low x (deg div 2) in
(if h < length treeList
then T⇩m⇩e⇩m⇩b⇩e⇩r' (treeList ! h) l
else 0))"
using 3 by simp
let ?h = "high x (deg div 2)"
let ?l = " low x (deg div 2)"
have "?h < length treeList"
using "5.hyps"(2) "5.hyps"(3) "5.hyps"(4) "5.hyps"(8) ‹x < ma› high_bound_aux
by (metis add_Suc_right add_self_div_2 even_Suc_div_two odd_add order.strict_trans)
hence 5:"T⇩m⇩e⇩m⇩b⇩e⇩r' (Node (Some (mi, ma)) deg treeList summary) x = 1+ T⇩m⇩e⇩m⇩b⇩e⇩r' (treeList ! ?h) ?l"
using "4" by presburger
moreover have "invar_vebt (treeList ! ?h) n ∧ (treeList ! ?h) ∈ set treeList "
using "5.IH"(1) ‹high x (deg div 2) < length treeList› nth_mem by blast
moreover hence " T⇩m⇩e⇩m⇩b⇩e⇩r' (treeList ! ?h) ?l ≤ (1 + height (treeList ! ?h))*1" using "5.IH"(1) by simp
ultimately have 6:"T⇩m⇩e⇩m⇩b⇩e⇩r' (Node (Some (mi, ma)) deg treeList summary) x ≤
1 + (1 + height (treeList ! ?h))" by simp
moreover have "i< length treeList ⟹
height (treeList ! i) ≤ Max (height ` (insert summary (set treeList)))" for i
apply (induction treeList arbitrary: i)
apply simp
apply (meson List.finite_set Max_ge finite_imageI finite_insert image_iff nth_mem subsetD subset_insertI)
done
moreover hence " (1 + height (treeList ! ?h)) ≤ height (Node (Some (mi, ma)) deg treeList summary)"
by (simp add: ‹high x (deg div 2) < length treeList›)
moreover hence " 14 * (1 + height (treeList ! ?h)) ≤ 14 * height (Node (Some (mi, ma)) deg treeList summary)" by simp
ultimately show ?thesis using 6 algebra_simps add_mono_thms_linordered_semiring(2) mult.right_neutral order_trans by force
qed
qed
qed
qed
qed simp+
theorem member_bound_size_univ: "invar_vebt t n ⟹ u = 2^n ⟹ T⇩m⇩e⇩m⇩b⇩e⇩r t x ≤ 30 + 15 * lb (lb u)"
using member_bound_height[of t n x] height_double_log_univ_size[of u n t] algebra_simps by simp
subsection ‹Minimum, Maximum, Emptiness Test›
fun T⇩m⇩i⇩n⇩t::"VEBT ⇒ nat" where
"T⇩m⇩i⇩n⇩t (Leaf a b) = (1+ (if a then 0 else 1 + (if b then 1 else 1)))"|
"T⇩m⇩i⇩n⇩t (Node None _ _ _) = 1"|
"T⇩m⇩i⇩n⇩t (Node (Some (mi,ma)) _ _ _ ) = 1"
lemma mint_bound: "T⇩m⇩i⇩n⇩t t ≤ 3" by (induction t rule: T⇩m⇩i⇩n⇩t.induct) auto
fun T⇩m⇩a⇩x⇩t::"VEBT ⇒ nat" where
"T⇩m⇩a⇩x⇩t (Leaf a b) = (1+ (if b then 1 else 1 +( if a then 1 else 1)))"|
"T⇩m⇩a⇩x⇩t (Node None _ _ _) = 1"|
"T⇩m⇩a⇩x⇩t (Node (Some (mi,ma)) _ _ _ ) = 1"
lemma maxt_bound: "T⇩m⇩a⇩x⇩t t ≤ 3" by (induction t rule: T⇩m⇩a⇩x⇩t.induct) auto
fun T⇩m⇩i⇩n⇩N⇩u⇩l⇩l::"VEBT ⇒ nat" where
"T⇩m⇩i⇩n⇩N⇩u⇩l⇩l (Leaf False False) = 1"|
"T⇩m⇩i⇩n⇩N⇩u⇩l⇩l (Leaf _ _ ) = 1"|
"T⇩m⇩i⇩n⇩N⇩u⇩l⇩l (Node None _ _ _) = 1"|
"T⇩m⇩i⇩n⇩N⇩u⇩l⇩l (Node (Some _) _ _ _) = 1"
lemma minNull_bound: "T⇩m⇩i⇩n⇩N⇩u⇩l⇩l t ≤ 1"
by (metis T⇩m⇩i⇩n⇩N⇩u⇩l⇩l.elims order_refl)
subsection ‹Insertion›
fun T⇩i⇩n⇩s⇩e⇩r⇩t::"VEBT ⇒ nat ⇒nat" where
"T⇩i⇩n⇩s⇩e⇩r⇩t (Leaf a b) x = 1+ (if x=0 then 1 else 1 + (if x=1 then 1 else 1))"|
"T⇩i⇩n⇩s⇩e⇩r⇩t (Node info 0 ts s) x = 1"|
"T⇩i⇩n⇩s⇩e⇩r⇩t (Node info (Suc 0) ts s) x = 1"|
"T⇩i⇩n⇩s⇩e⇩r⇩t (Node None (Suc deg) treeList summary) x = 2"|
"T⇩i⇩n⇩s⇩e⇩r⇩t (Node (Some (mi,ma)) deg treeList summary) x = 19+
( let xn = (if x < mi then mi else x); minn = (if x< mi then x else mi);
l= low xn (deg div 2); h = high xn (deg div 2)
in
( if h < length treeList ∧ ¬ (x = mi ∨ x = ma)then
T⇩i⇩n⇩s⇩e⇩r⇩t (treeList ! h) l + T⇩m⇩i⇩n⇩N⇩u⇩l⇩l (treeList ! h)+
(if minNull (treeList ! h) then T⇩i⇩n⇩s⇩e⇩r⇩t summary h else 1)
else 1))"
fun T⇩i⇩n⇩s⇩e⇩r⇩t'::"VEBT ⇒ nat ⇒nat" where
"T⇩i⇩n⇩s⇩e⇩r⇩t' (Leaf a b) x = 1"|
"T⇩i⇩n⇩s⇩e⇩r⇩t' (Node info 0 ts s) x = 1"|
"T⇩i⇩n⇩s⇩e⇩r⇩t' (Node info (Suc 0) ts s) x = 1"|
"T⇩i⇩n⇩s⇩e⇩r⇩t' (Node None (Suc deg) treeList summary) x = 1"|
"T⇩i⇩n⇩s⇩e⇩r⇩t' (Node (Some (mi,ma)) deg treeList summary) x =
(let xn = (if x < mi then mi else x); minn = (if x< mi then x else mi);
l= low xn (deg div 2); h = high xn (deg div 2)
in ( if h < length treeList ∧ ¬ (x = mi ∨ x = ma)then
T⇩i⇩n⇩s⇩e⇩r⇩t' (treeList ! h) l +
(if minNull (treeList ! h) then T⇩i⇩n⇩s⇩e⇩r⇩t' summary h else 1) else 1))"
lemma insersimp:assumes "invar_vebt t n" and "∄ x. both_member_options t x " shows "T⇩i⇩n⇩s⇩e⇩r⇩t t y ≤ 3"
proof-
from assms(1) show ?thesis
proof(cases)
case (1 a b)
then show ?thesis by simp
next
case (2 treeList n summary m)
hence "n+m ≥ 2"
by (metis add_self_div_2 deg_not_0 div_greater_zero_iff)
then show ?thesis using T⇩i⇩n⇩s⇩e⇩r⇩t.simps(4)[of "n+m-2" treeList summary y]
by (metis "2"(1) "2"(6) add.commute add_2_eq_Suc le_add2 numeral_3_eq_3 ordered_cancel_comm_monoid_diff_class.add_diff_inverse)
next
case (3 treeList n summary m)
hence "n+m ≥ 2"
by (metis add_mono_thms_linordered_semiring(1) le_add1 nat_1_add_1 plus_1_eq_Suc set_n_deg_not_0)
then show ?thesis using T⇩i⇩n⇩s⇩e⇩r⇩t.simps(4)[of "n+m-2" treeList summary y]
by (metis "3"(1) "3"(6) add.commute add_2_eq_Suc le_add2 numeral_3_eq_3 ordered_cancel_comm_monoid_diff_class.add_diff_inverse)
next
case (4 treeList n summary m mi ma)
hence "membermima (Node (Some (mi, ma)) (n+m) treeList summary) mi "
by (metis Suc_pred assms(1) deg_not_0 membermima.simps(4))
hence False
using "4"(1) "4"(6) assms(2) both_member_options_def by blast
then show ?thesis by simp
next
case (5 treeList n summary m mi ma)
hence "membermima (Node (Some (mi, ma)) (n+m) treeList summary) mi "
by (metis Suc_pred assms(1) deg_not_0 membermima.simps(4))
hence False
using "5"(1) "5"(6) assms(2) both_member_options_def by blast
then show ?thesis by simp
qed
qed
lemma insertsimp: "invar_vebt t n ⟹ minNull t ⟹ T⇩i⇩n⇩s⇩e⇩r⇩t t l ≤ 3"
using insersimp min_Null_member valid_member_both_member_options by blast
lemma insersimp':assumes "invar_vebt t n" and "∄ x. both_member_options t x " shows "T⇩i⇩n⇩s⇩e⇩r⇩t' t y ≤ 1"
using assms(1)
apply cases
apply simp
apply(metis add_self_div_2 deg_not_0 div_greater_zero_iff T⇩i⇩n⇩s⇩e⇩r⇩t'.simps(4) add_2_eq_Suc dual_order.refl less_eqE)
apply(cases "n≥ 2")
apply(smt (z3) T⇩i⇩n⇩s⇩e⇩r⇩t'.simps(4)[of "n-2"] T⇩i⇩n⇩s⇩e⇩r⇩t'.elims le_Suc_eq add_2_eq_Suc le_refl ordered_cancel_comm_monoid_diff_class.add_diff_inverse)
apply (metis Suc_1 add_mono_thms_linordered_semiring(1) le_add1 plus_1_eq_Suc set_n_deg_not_0)
apply(cases "n≥ 2")
apply(metis Suc_pred assms(1) assms(2) both_member_options_def deg_not_0 membermima.simps(4))
apply(metis add_self_div_2 deg_not_0 div_greater_zero_iff T⇩i⇩n⇩s⇩e⇩r⇩t'.simps(4) add_2_eq_Suc dual_order.refl less_eqE)
apply(cases "n≥ 2")
apply(metis Suc_pred assms(1) assms(2) both_member_options_def deg_not_0 membermima.simps(4))
apply (metis Suc_1 add_mono_thms_linordered_semiring(1) le_add1 plus_1_eq_Suc set_n_deg_not_0)
done
lemma insertsimp': "invar_vebt t n ⟹ minNull t ⟹ T⇩i⇩n⇩s⇩e⇩r⇩t' t l ≤ 1"
using insersimp' min_Null_member valid_member_both_member_options by blast
theorem insert_bound_height: "invar_vebt t n ⟹ T⇩i⇩n⇩s⇩e⇩r⇩t t x ≤ (1+height t)*23"
proof(induction t n arbitrary: x rule: invar_vebt.induct)
case (1 a b)
then show ?case
using T⇩i⇩n⇩s⇩e⇩r⇩t.simps(1)[of a b x] height.simps(1)[of a b] by simp+
next
case (2 treeList n summary m deg)
hence "deg ≥ 2"
by (metis add_self_div_2 deg_not_0 div_greater_zero_iff)
moreover hence "height (Node None deg treeList summary) ≥ 1" using height.simps(2)[of None deg treeList summary] by simp
ultimately show ?case using T⇩i⇩n⇩s⇩e⇩r⇩t.simps(4)[of "deg-2"treeList summary x] algebra_simps
by (smt (z3) Suc_1 add_lessD1 eval_nat_numeral(3) le_add_diff_inverse less_Suc_eq_le linorder_not_less mult.left_neutral plus_1_eq_Suc)
next
case (3 treeList n summary m deg)
hence "deg ≥ 2"
by (metis Suc_1 add_mono_thms_linordered_semiring(1) le_add1 plus_1_eq_Suc set_n_deg_not_0)
moreover hence "height (Node None deg treeList summary) ≥ 1" using height.simps(2)[of None deg treeList summary] by simp
ultimately show ?case using T⇩i⇩n⇩s⇩e⇩r⇩t.simps(4)[of "deg-2"treeList summary x] algebra_simps
by (smt (z3) Suc_1 add_lessD1 eval_nat_numeral(3) le_add_diff_inverse less_Suc_eq_le linorder_not_less mult.left_neutral plus_1_eq_Suc)
next
case (4 treeList n summary m deg mi ma)
hence "deg ≥ 2"
by (metis add_self_div_2 deg_not_0 div_greater_zero_iff)
let ?xn = "(if x < mi then mi else x)"
let ?minn = "(if x< mi then x else mi)"
let ?l= "low ?xn (deg div 2)"
let ?h = "high ?xn (deg div 2)"
show ?case
proof(cases "x < mi")
case True
hence 0:"T⇩i⇩n⇩s⇩e⇩r⇩t (Node (Some (mi,ma)) deg treeList summary) x = 19+
( if ?h < length treeList ∧ ¬ (x = mi ∨ x = ma)then
T⇩i⇩n⇩s⇩e⇩r⇩t (treeList ! ?h) ?l + T⇩m⇩i⇩n⇩N⇩u⇩l⇩l (treeList ! ?h)+
(if minNull (treeList ! ?h) then T⇩i⇩n⇩s⇩e⇩r⇩t summary ?h else 1) else 1)"
using T⇩i⇩n⇩s⇩e⇩r⇩t.simps(5)[of mi ma "deg -2 " treeList summary x]
by (smt (z3) ‹2 ≤ deg› add_2_eq_Suc le_add_diff_inverse)
then show ?thesis
proof(cases " ?h < length treeList ∧ ¬ (x = mi ∨ x = ma)")
case True
hence 1: "T⇩i⇩n⇩s⇩e⇩r⇩t (Node (Some (mi,ma)) deg treeList summary) x = 19+
T⇩i⇩n⇩s⇩e⇩r⇩t (treeList ! ?h) ?l + T⇩m⇩i⇩n⇩N⇩u⇩l⇩l (treeList ! ?h)+
(if minNull (treeList ! ?h) then T⇩i⇩n⇩s⇩e⇩r⇩t summary ?h else 1)"
using 0 by simp
then show ?thesis
proof(cases " minNull (treeList ! ?h)")
case True
hence " T⇩i⇩n⇩s⇩e⇩r⇩t (treeList ! ?h) ?l ≤ 3"
by (smt (z3) "0" "1" "4.IH"(1) insertsimp le_add1 nat_add_left_cancel_le nth_mem numeral_3_eq_3 order_trans plus_1_eq_Suc)
hence 2: "T⇩i⇩n⇩s⇩e⇩r⇩t (Node (Some (mi,ma)) deg treeList summary) x ≤ 22 +
T⇩m⇩i⇩n⇩N⇩u⇩l⇩l (treeList ! ?h)+
(if minNull (treeList ! ?h) then T⇩i⇩n⇩s⇩e⇩r⇩t summary ?h else 1)"
using 1 algebra_simps by simp
hence "T⇩i⇩n⇩s⇩e⇩r⇩t (Node (Some (mi,ma)) deg treeList summary) x ≤ 23 +
(if minNull (treeList ! ?h) then T⇩i⇩n⇩s⇩e⇩r⇩t summary ?h else 1)"
by (smt (verit, ccfv_SIG) add.commute minNull_bound nat_add_left_cancel_le numeral_Bit0 numeral_Bit1 order_trans)
hence "T⇩i⇩n⇩s⇩e⇩r⇩t (Node (Some (mi,ma)) deg treeList summary) x ≤ 23 + T⇩i⇩n⇩s⇩e⇩r⇩t summary ?h" using True by simp
hence "T⇩i⇩n⇩s⇩e⇩r⇩t (Node (Some (mi,ma)) deg treeList summary) x ≤ 23 + (height summary +1)*23" using "4.IH"(2)
by (smt (verit) add.commute add_le_cancel_left add_le_mono add_mono_thms_linordered_semiring(1) nat_add_left_cancel_le)
hence "T⇩i⇩n⇩s⇩e⇩r⇩t (Node (Some (mi,ma)) deg treeList summary) x ≤ ((1+ height summary)+1 )*23" by simp
then show ?thesis using height_compose_summary[of summary "Some (mi, ma)" deg treeList] algebra_simps
by (simp add: ‹1 + height summary ≤ height (Node (Some (mi, ma)) deg treeList summary)› ‹T⇩i⇩n⇩s⇩e⇩r⇩t (Node (Some (mi, ma)) deg treeList summary) x ≤ (1 + height summary + 1) * 23› add.assoc add.commute add.left_commute add_diff_eq diff_add_eq diff_diff_add diff_diff_eq2 diff_eq_eq diff_le_eq diff_less_eq distrib_left distrib_right eq_diff_eq le_diff_eq left_diff_distrib left_diff_distrib' less_diff_eq mult.assoc mult.commute mult.left_commute power_mult_distrib right_diff_distrib right_diff_distrib' scaleR_add_left scaleR_add_right scale_left_diff_distrib scale_right_diff_distrib add_mono le_trans mult_le_mono order_refl)
next
case False
hence 2:"T⇩i⇩n⇩s⇩e⇩r⇩t (Node (Some (mi,ma)) deg treeList summary) x = 20+
T⇩i⇩n⇩s⇩e⇩r⇩t (treeList ! ?h) ?l + T⇩m⇩i⇩n⇩N⇩u⇩l⇩l (treeList ! ?h)" using 1 by simp
hence "T⇩i⇩n⇩s⇩e⇩r⇩t (Node (Some (mi,ma)) deg treeList summary) x ≤ 23+ T⇩i⇩n⇩s⇩e⇩r⇩t (treeList ! ?h) ?l "
using minNull_bound[of "treeList ! ?h"] algebra_simps by linarith
hence "T⇩i⇩n⇩s⇩e⇩r⇩t (Node (Some (mi,ma)) deg treeList summary) x ≤ 23+ (1+ height (treeList ! ?h))*23"
by (meson "4.IH"(1) True nat_add_left_cancel_le nth_mem order_trans)
hence "T⇩i⇩n⇩s⇩e⇩r⇩t (Node (Some (mi,ma)) deg treeList summary) x ≤ ((1+ height (treeList!?h))+1)*23" by simp
moreover have " (treeList!?h) ∈ set treeList"
using True nth_mem by blast
ultimately show ?thesis using height_compose_child[of "treeList!?h" treeList "Some (mi, ma)" deg summary] algebra_simps
by (smt (verit, ccfv_SIG) Suc_leI add.right_neutral le_add1 le_imp_less_Suc mult_le_mono order_trans plus_1_eq_Suc)
qed
next
case False
then show ?thesis
using "4.hyps"(2) "4.hyps"(3) "4.hyps"(4) "4.hyps"(7) "4.hyps"(8) True high_bound_aux by auto
qed
next
case False
hence 0:"T⇩i⇩n⇩s⇩e⇩r⇩t (Node (Some (mi,ma)) deg treeList summary) x = 19+
( if ?h < length treeList ∧ ¬ (x = mi ∨ x = ma)then
T⇩i⇩n⇩s⇩e⇩r⇩t (treeList ! ?h) ?l + T⇩m⇩i⇩n⇩N⇩u⇩l⇩l (treeList ! ?h)+
(if minNull (treeList ! ?h) then T⇩i⇩n⇩s⇩e⇩r⇩t summary ?h else 1) else 1)"
using T⇩i⇩n⇩s⇩e⇩r⇩t.simps(5)[of mi ma "deg -2 " treeList summary x]
by (smt (z3) ‹2 ≤ deg› add_2_eq_Suc le_add_diff_inverse)
then show ?thesis
proof(cases " ?h < length treeList ∧ ¬ (x = mi ∨ x = ma)")
case True
hence 1: "T⇩i⇩n⇩s⇩e⇩r⇩t (Node (Some (mi,ma)) deg treeList summary) x = 19+
T⇩i⇩n⇩s⇩e⇩r⇩t (treeList ! ?h) ?l + T⇩m⇩i⇩n⇩N⇩u⇩l⇩l (treeList ! ?h)+
(if minNull (treeList ! ?h) then T⇩i⇩n⇩s⇩e⇩r⇩t summary ?h else 1)"
using 0 by simp
then show ?thesis
proof(cases " minNull (treeList ! ?h)")
case True
hence " T⇩i⇩n⇩s⇩e⇩r⇩t (treeList ! ?h) ?l ≤ 3"
by (smt (z3) "0" "1" "4.IH"(1) insertsimp le_add1 nat_add_left_cancel_le nth_mem numeral_3_eq_3 order_trans plus_1_eq_Suc)
hence 2: "T⇩i⇩n⇩s⇩e⇩r⇩t (Node (Some (mi,ma)) deg treeList summary) x ≤ 22 +
T⇩m⇩i⇩n⇩N⇩u⇩l⇩l (treeList ! ?h)+
(if minNull (treeList ! ?h) then T⇩i⇩n⇩s⇩e⇩r⇩t summary ?h else 1)"
using 1 algebra_simps by simp
hence "T⇩i⇩n⇩s⇩e⇩r⇩t (Node (Some (mi,ma)) deg treeList summary) x ≤ 23 +
(if minNull (treeList ! ?h) then T⇩i⇩n⇩s⇩e⇩r⇩t summary ?h else 1)"
by (smt (verit, ccfv_SIG) add.commute minNull_bound nat_add_left_cancel_le numeral_Bit0 numeral_Bit1 order_trans)
hence "T⇩i⇩n⇩s⇩e⇩r⇩t (Node (Some (mi,ma)) deg treeList summary) x ≤ 23 + T⇩i⇩n⇩s⇩e⇩r⇩t summary ?h" using True by simp
hence "T⇩i⇩n⇩s⇩e⇩r⇩t (Node (Some (mi,ma)) deg treeList summary) x ≤ 23 + (height summary +1)*23" using "4.IH"(2)
by (smt (verit) add.commute add_le_cancel_left add_le_mono add_mono_thms_linordered_semiring(1) nat_add_left_cancel_le)
hence "T⇩i⇩n⇩s⇩e⇩r⇩t (Node (Some (mi,ma)) deg treeList summary) x ≤ ((1+ height summary)+1 )*23" by simp
then show ?thesis using height_compose_summary[of summary "Some (mi, ma)" deg treeList] algebra_simps
by (simp add: ‹1 + height summary ≤ height (Node (Some (mi, ma)) deg treeList summary)› ‹T⇩i⇩n⇩s⇩e⇩r⇩t (Node (Some (mi, ma)) deg treeList summary) x ≤ (1 + height summary + 1) * 23› add.assoc add.commute add.left_commute add_diff_eq diff_add_eq diff_diff_add diff_diff_eq2 diff_eq_eq diff_le_eq diff_less_eq distrib_left distrib_right eq_diff_eq le_diff_eq left_diff_distrib left_diff_distrib' less_diff_eq mult.assoc mult.commute mult.left_commute power_mult_distrib right_diff_distrib right_diff_distrib' scaleR_add_left scaleR_add_right scale_left_diff_distrib scale_right_diff_distrib add_mono le_trans mult_le_mono order_refl)
next
case False
hence 2:"T⇩i⇩n⇩s⇩e⇩r⇩t (Node (Some (mi,ma)) deg treeList summary) x = 20+
T⇩i⇩n⇩s⇩e⇩r⇩t (treeList ! ?h) ?l + T⇩m⇩i⇩n⇩N⇩u⇩l⇩l (treeList ! ?h)" using 1 by simp
hence "T⇩i⇩n⇩s⇩e⇩r⇩t (Node (Some (mi,ma)) deg treeList summary) x ≤ 23+ T⇩i⇩n⇩s⇩e⇩r⇩t (treeList ! ?h) ?l "
using minNull_bound[of "treeList ! ?h"] algebra_simps by linarith
hence "T⇩i⇩n⇩s⇩e⇩r⇩t (Node (Some (mi,ma)) deg treeList summary) x ≤ 23+ (1+ height (treeList ! ?h))*23"
by (meson "4.IH"(1) True nat_add_left_cancel_le nth_mem order_trans)
hence "T⇩i⇩n⇩s⇩e⇩r⇩t (Node (Some (mi,ma)) deg treeList summary) x ≤ ((1+ height (treeList!?h))+1)*23" by simp
moreover have " (treeList!?h) ∈ set treeList"
using True nth_mem by blast
ultimately show ?thesis using height_compose_child[of "treeList!?h" treeList "Some (mi, ma)" deg summary] algebra_simps
by (smt (verit, ccfv_SIG) Suc_leI add.right_neutral le_add1 le_imp_less_Suc mult_le_mono order_trans plus_1_eq_Suc)
qed
next
case False
then show ?thesis
using "0" by force
qed
qed
next
case (5 treeList n summary m deg mi ma)
hence "deg ≥ 2"
by (metis Suc_1 add_mono_thms_linordered_semiring(1) le_add1 plus_1_eq_Suc set_n_deg_not_0)
let ?xn = "(if x < mi then mi else x)"
let ?minn = "(if x< mi then x else mi)"
let ?l= "low ?xn (deg div 2)"
let ?h = "high ?xn (deg div 2)"
show ?case
proof(cases "x < mi")
case True
hence 0:"T⇩i⇩n⇩s⇩e⇩r⇩t (Node (Some (mi,ma)) deg treeList summary) x = 19+
( if ?h < length treeList ∧ ¬ (x = mi ∨ x = ma)then
T⇩i⇩n⇩s⇩e⇩r⇩t (treeList ! ?h) ?l + T⇩m⇩i⇩n⇩N⇩u⇩l⇩l (treeList ! ?h)+
(if minNull (treeList ! ?h) then T⇩i⇩n⇩s⇩e⇩r⇩t summary ?h else 1) else 1)"
using T⇩i⇩n⇩s⇩e⇩r⇩t.simps(5)[of mi ma "deg -2 " treeList summary x]
by (smt (z3) ‹2 ≤ deg› add_2_eq_Suc le_add_diff_inverse)
then show ?thesis
proof(cases " ?h < length treeList ∧ ¬ (x = mi ∨ x = ma)")
case True
hence 1: "T⇩i⇩n⇩s⇩e⇩r⇩t (Node (Some (mi,ma)) deg treeList summary) x = 19+
T⇩i⇩n⇩s⇩e⇩r⇩t (treeList ! ?h) ?l + T⇩m⇩i⇩n⇩N⇩u⇩l⇩l (treeList ! ?h)+
(if minNull (treeList ! ?h) then T⇩i⇩n⇩s⇩e⇩r⇩t summary ?h else 1)"
using 0 by simp
then show ?thesis
proof(cases " minNull (treeList ! ?h)")
case True
hence " T⇩i⇩n⇩s⇩e⇩r⇩t (treeList ! ?h) ?l ≤ 3"
by (smt (z3) "0" "1" "5.IH"(1) insertsimp le_add1 nat_add_left_cancel_le nth_mem numeral_3_eq_3 order_trans plus_1_eq_Suc)
hence 2: "T⇩i⇩n⇩s⇩e⇩r⇩t (Node (Some (mi,ma)) deg treeList summary) x ≤ 22 +
T⇩m⇩i⇩n⇩N⇩u⇩l⇩l (treeList ! ?h)+(if minNull (treeList ! ?h) then T⇩i⇩n⇩s⇩e⇩r⇩t summary ?h else 1)"
using 1 algebra_simps by simp
hence "T⇩i⇩n⇩s⇩e⇩r⇩t (Node (Some (mi,ma)) deg treeList summary) x ≤
23 + (if minNull (treeList ! ?h) then T⇩i⇩n⇩s⇩e⇩r⇩t summary ?h else 1)"
by (smt (verit, ccfv_SIG) add.commute minNull_bound nat_add_left_cancel_le numeral_Bit0 numeral_Bit1 order_trans)
hence "T⇩i⇩n⇩s⇩e⇩r⇩t (Node (Some (mi,ma)) deg treeList summary) x ≤ 23 + T⇩i⇩n⇩s⇩e⇩r⇩t summary ?h" using True by simp
hence "T⇩i⇩n⇩s⇩e⇩r⇩t (Node (Some (mi,ma)) deg treeList summary) x ≤ 23 + (height summary +1)*23" using "5.IH"(2)
by (smt (verit) add.commute add_le_cancel_left add_le_mono add_mono_thms_linordered_semiring(1) nat_add_left_cancel_le)
hence "T⇩i⇩n⇩s⇩e⇩r⇩t (Node (Some (mi,ma)) deg treeList summary) x ≤ ((1+ height summary)+1 )*23" by simp
then show ?thesis using height_compose_summary[of summary "Some (mi, ma)" deg treeList] algebra_simps
by (simp add: ‹1 + height summary ≤ height (Node (Some (mi, ma)) deg treeList summary)› ‹T⇩i⇩n⇩s⇩e⇩r⇩t (Node (Some (mi, ma)) deg treeList summary) x ≤ (1 + height summary + 1) * 23› add.assoc add.commute add.left_commute add_diff_eq diff_add_eq diff_diff_add diff_diff_eq2 diff_eq_eq diff_le_eq diff_less_eq distrib_left distrib_right eq_diff_eq le_diff_eq left_diff_distrib left_diff_distrib' less_diff_eq mult.assoc mult.commute mult.left_commute power_mult_distrib right_diff_distrib right_diff_distrib' scaleR_add_left scaleR_add_right scale_left_diff_distrib scale_right_diff_distrib add_mono le_trans mult_le_mono order_refl)
next
case False
hence 2:"T⇩i⇩n⇩s⇩e⇩r⇩t (Node (Some (mi,ma)) deg treeList summary) x = 20+
T⇩i⇩n⇩s⇩e⇩r⇩t (treeList ! ?h) ?l + T⇩m⇩i⇩n⇩N⇩u⇩l⇩l (treeList ! ?h)" using 1 by simp
hence "T⇩i⇩n⇩s⇩e⇩r⇩t (Node (Some (mi,ma)) deg treeList summary) x ≤ 23+ T⇩i⇩n⇩s⇩e⇩r⇩t (treeList ! ?h) ?l "
using minNull_bound[of "treeList ! ?h"] algebra_simps by linarith
hence "T⇩i⇩n⇩s⇩e⇩r⇩t (Node (Some (mi,ma)) deg treeList summary) x ≤ 23+ (1+ height (treeList ! ?h))*23"
by (meson "5.IH"(1) True nat_add_left_cancel_le nth_mem order_trans)
hence "T⇩i⇩n⇩s⇩e⇩r⇩t (Node (Some (mi,ma)) deg treeList summary) x ≤ ((1+ height (treeList!?h))+1)*23" by simp
moreover have " (treeList!?h) ∈ set treeList"
using True nth_mem by blast
ultimately show ?thesis using height_compose_child[of "treeList!?h" treeList "Some (mi, ma)" deg summary] algebra_simps
by (smt (verit, ccfv_SIG) Suc_leI add.right_neutral le_add1 le_imp_less_Suc mult_le_mono order_trans plus_1_eq_Suc)
qed
next
case False
then show ?thesis
by (smt (z3) "0" Suc_eq_plus1 Suc_numeral add_lessD1 linorder_not_less mult_Suc not_add_less1 plus_1_eq_Suc semiring_norm(5) semiring_norm(8))
qed
next
case False
hence 0:"T⇩i⇩n⇩s⇩e⇩r⇩t (Node (Some (mi,ma)) deg treeList summary) x = 19+
( if ?h < length treeList ∧ ¬ (x = mi ∨ x = ma)then
T⇩i⇩n⇩s⇩e⇩r⇩t (treeList ! ?h) ?l + T⇩m⇩i⇩n⇩N⇩u⇩l⇩l (treeList ! ?h)+
(if minNull (treeList ! ?h) then T⇩i⇩n⇩s⇩e⇩r⇩t summary ?h else 1) else 1)"
using T⇩i⇩n⇩s⇩e⇩r⇩t.simps(5)[of mi ma "deg -2 " treeList summary x]
by (smt (z3) ‹2 ≤ deg› add_2_eq_Suc le_add_diff_inverse)
then show ?thesis
proof(cases " ?h < length treeList ∧ ¬ (x = mi ∨ x = ma)")
case True
hence 1: "T⇩i⇩n⇩s⇩e⇩r⇩t (Node (Some (mi,ma)) deg treeList summary) x = 19+
T⇩i⇩n⇩s⇩e⇩r⇩t (treeList ! ?h) ?l + T⇩m⇩i⇩n⇩N⇩u⇩l⇩l (treeList ! ?h)+
(if minNull (treeList ! ?h) then T⇩i⇩n⇩s⇩e⇩r⇩t summary ?h else 1)"
using 0 by simp
then show ?thesis
proof(cases " minNull (treeList ! ?h)")
case True
hence " T⇩i⇩n⇩s⇩e⇩r⇩t (treeList ! ?h) ?l ≤ 3"
by (smt (z3) "0" "1" "5.IH"(1) insertsimp le_add1 nat_add_left_cancel_le nth_mem
numeral_3_eq_3 order_trans plus_1_eq_Suc)
hence 2: "T⇩i⇩n⇩s⇩e⇩r⇩t (Node (Some (mi,ma)) deg treeList summary) x ≤ 22 +
T⇩m⇩i⇩n⇩N⇩u⇩l⇩l (treeList ! ?h)+(if minNull (treeList ! ?h) then T⇩i⇩n⇩s⇩e⇩r⇩t summary ?h else 1)"
using 1 algebra_simps by simp
hence "T⇩i⇩n⇩s⇩e⇩r⇩t (Node (Some (mi,ma)) deg treeList summary) x ≤ 23 +
(if minNull (treeList ! ?h) then T⇩i⇩n⇩s⇩e⇩r⇩t summary ?h else 1)"
by (smt (verit, ccfv_SIG) add.commute minNull_bound nat_add_left_cancel_le numeral_Bit0 numeral_Bit1 order_trans)
hence "T⇩i⇩n⇩s⇩e⇩r⇩t (Node (Some (mi,ma)) deg treeList summary) x ≤ 23 + T⇩i⇩n⇩s⇩e⇩r⇩t summary ?h" using True by simp
hence "T⇩i⇩n⇩s⇩e⇩r⇩t (Node (Some (mi,ma)) deg treeList summary) x ≤ 23 + (height summary +1)*23" using "5.IH"(2)
by (smt (verit) add.commute add_le_cancel_left add_le_mono add_mono_thms_linordered_semiring(1) nat_add_left_cancel_le)
hence "T⇩i⇩n⇩s⇩e⇩r⇩t (Node (Some (mi,ma)) deg treeList summary) x ≤ ((1+ height summary)+1 )*23" by simp
then show ?thesis using height_compose_summary[of summary "Some (mi, ma)" deg treeList] algebra_simps
by (simp add: ‹1 + height summary ≤ height (Node (Some (mi, ma)) deg treeList summary)› ‹T⇩i⇩n⇩s⇩e⇩r⇩t (Node (Some (mi, ma)) deg treeList summary) x ≤ (1 + height summary + 1) * 23› add.assoc add.commute add.left_commute add_diff_eq diff_add_eq diff_diff_add diff_diff_eq2 diff_eq_eq diff_le_eq diff_less_eq distrib_left distrib_right eq_diff_eq le_diff_eq left_diff_distrib left_diff_distrib' less_diff_eq mult.assoc mult.commute mult.left_commute power_mult_distrib right_diff_distrib right_diff_distrib' scaleR_add_left scaleR_add_right scale_left_diff_distrib scale_right_diff_distrib add_mono le_trans mult_le_mono order_refl)
next
case False
hence 2:"T⇩i⇩n⇩s⇩e⇩r⇩t (Node (Some (mi,ma)) deg treeList summary) x = 20+
T⇩i⇩n⇩s⇩e⇩r⇩t (treeList ! ?h) ?l + T⇩m⇩i⇩n⇩N⇩u⇩l⇩l (treeList ! ?h)" using 1 by simp
hence "T⇩i⇩n⇩s⇩e⇩r⇩t (Node (Some (mi,ma)) deg treeList summary) x ≤ 23+ T⇩i⇩n⇩s⇩e⇩r⇩t (treeList ! ?h) ?l "
using minNull_bound[of "treeList ! ?h"] algebra_simps by linarith
hence "T⇩i⇩n⇩s⇩e⇩r⇩t (Node (Some (mi,ma)) deg treeList summary) x ≤ 23+ (1+ height (treeList ! ?h))*23"
by (meson "5.IH"(1) True nat_add_left_cancel_le nth_mem order_trans)
hence "T⇩i⇩n⇩s⇩e⇩r⇩t (Node (Some (mi,ma)) deg treeList summary) x ≤ ((1+ height (treeList!?h))+1)*23" by simp
moreover have " (treeList!?h) ∈ set treeList"
using True nth_mem by blast
ultimately show ?thesis using height_compose_child[of "treeList!?h" treeList "Some (mi, ma)" deg summary] algebra_simps
by (smt (verit, ccfv_SIG) Suc_leI add.right_neutral le_add1 le_imp_less_Suc mult_le_mono order_trans plus_1_eq_Suc)
qed
next
case False
then show ?thesis
using "0" by force
qed
qed
qed
theorem insert_bound_size_univ: "invar_vebt t n ⟹ u = 2^n ⟹ T⇩i⇩n⇩s⇩e⇩r⇩t t x ≤ 46 + 23 * lb (lb u)"
using insert_bound_height[of t n x] height_double_log_univ_size[of u n t] algebra_simps by simp
theorem insert'_bound_height: "invar_vebt t n ⟹ T⇩i⇩n⇩s⇩e⇩r⇩t' t x ≤ (1+height t)"
proof(induction t n arbitrary: x rule: invar_vebt.induct )
case (2 treeList n summary m deg)
then show ?case apply(cases "deg ≥ 2")
apply (metis "2.hyps"(1) "2.hyps"(3) "2.hyps"(4) Suc_leI T⇩i⇩n⇩s⇩e⇩r⇩t'.simps(4) add_le_cancel_right deg_not_0 le_add2 le_add_diff_inverse nat_less_le plus_1_eq_Suc)
apply (metis add_self_div_2 deg_not_0 div_greater_zero_iff)
done
next
case (3 treeList n summary m deg)
then show ?case apply(cases "deg ≥ 2")
apply (metis T⇩i⇩n⇩s⇩e⇩r⇩t'.simps(4) add_Suc_shift leI le_Suc_ex not_add_less1 one_add_one plus_1_eq_Suc)
by (metis One_nat_def Suc_eq_plus1 T⇩i⇩n⇩s⇩e⇩r⇩t'.simps(3) add.commute add_mono le_SucE le_add1 numeral_2_eq_2)
next
case (4 treeList n summary m deg mi ma)
hence "deg ≥ 2"
by (metis add_self_div_2 deg_not_0 div_greater_zero_iff)
let ?xn = "(if x < mi then mi else x)"
let ?minn = "(if x< mi then x else mi)"
let ?l= "low ?xn (deg div 2)"
let ?h = "high ?xn (deg div 2)"
show ?case
proof(cases "x < mi")
case True
hence 0:"T⇩i⇩n⇩s⇩e⇩r⇩t' (Node (Some (mi,ma)) deg treeList summary) x =
( if ?h < length treeList ∧ ¬ (x = mi ∨ x = ma)then
T⇩i⇩n⇩s⇩e⇩r⇩t' (treeList ! ?h) ?l + (if minNull (treeList ! ?h) then T⇩i⇩n⇩s⇩e⇩r⇩t' summary ?h else 1) else 1)"
using T⇩i⇩n⇩s⇩e⇩r⇩t'.simps(5)[of mi ma "deg -2 " treeList summary x]
by (smt (z3) ‹2 ≤ deg› add_2_eq_Suc le_add_diff_inverse)
then show ?thesis
proof(cases " ?h < length treeList ∧ ¬ (x = mi ∨ x = ma)")
case True
hence 1: "T⇩i⇩n⇩s⇩e⇩r⇩t' (Node (Some (mi,ma)) deg treeList summary) x =
T⇩i⇩n⇩s⇩e⇩r⇩t' (treeList ! ?h) ?l +(if minNull (treeList ! ?h) then T⇩i⇩n⇩s⇩e⇩r⇩t' summary ?h else 1)"
using 0 by simp
then show ?thesis
proof(cases " minNull (treeList ! ?h)")
case True
hence " T⇩i⇩n⇩s⇩e⇩r⇩t' (treeList ! ?h) ?l ≤ 1"
by (metis "0" "1" "4.IH"(1) insertsimp' nat_le_iff_add nth_mem)
hence 2: "T⇩i⇩n⇩s⇩e⇩r⇩t' (Node (Some (mi,ma)) deg treeList summary) x ≤ 1+
(if minNull (treeList ! ?h) then T⇩i⇩n⇩s⇩e⇩r⇩t' summary ?h else 1)"
using 1 algebra_simps by simp
hence "T⇩i⇩n⇩s⇩e⇩r⇩t' (Node (Some (mi,ma)) deg treeList summary) x ≤ 1 + T⇩i⇩n⇩s⇩e⇩r⇩t' summary ?h" using True by simp
hence "T⇩i⇩n⇩s⇩e⇩r⇩t' (Node (Some (mi,ma)) deg treeList summary) x ≤ 1 + (height summary +1)" using "4.IH"(2)
using "1" ‹T⇩i⇩n⇩s⇩e⇩r⇩t' (treeList ! high (if x < mi then mi else x) (deg div 2)) (low (if x < mi then mi else x) (deg div 2)) ≤ 1› add_mono_thms_linordered_semiring(1) by fastforce
then show ?thesis using height_compose_summary[of summary "Some (mi, ma)" deg treeList] algebra_simps by linarith
next
case False
hence 2:"T⇩i⇩n⇩s⇩e⇩r⇩t' (Node (Some (mi,ma)) deg treeList summary) x =
1+ T⇩i⇩n⇩s⇩e⇩r⇩t' (treeList ! ?h) ?l " using 1 by simp
hence "T⇩i⇩n⇩s⇩e⇩r⇩t' (Node (Some (mi,ma)) deg treeList summary) x ≤ 1+ (1+ height (treeList ! ?h))"
using "4.IH"(1) True by force
moreover have " (treeList!?h) ∈ set treeList"
using True nth_mem by blast
ultimately show ?thesis using height_compose_child[of "treeList!?h" treeList "Some (mi, ma)" deg summary] algebra_simps
by (smt (verit, ccfv_SIG) Suc_leI add.right_neutral le_add1 le_imp_less_Suc mult_le_mono order_trans plus_1_eq_Suc)
qed
next
case False
then show ?thesis using "0" Suc_eq_plus1 le_add2 plus_1_eq_Suc by presburger
qed
next
case False
hence 0:"T⇩i⇩n⇩s⇩e⇩r⇩t' (Node (Some (mi,ma)) deg treeList summary) x =
( if ?h < length treeList ∧ ¬ (x = mi ∨ x = ma)then
T⇩i⇩n⇩s⇩e⇩r⇩t' (treeList ! ?h) ?l + (if minNull (treeList ! ?h) then T⇩i⇩n⇩s⇩e⇩r⇩t' summary ?h else 1) else 1)"
using T⇩i⇩n⇩s⇩e⇩r⇩t'.simps(5)[of mi ma "deg -2 " treeList summary x]
by (smt (z3) ‹2 ≤ deg› add_2_eq_Suc le_add_diff_inverse)
then show ?thesis
proof(cases " ?h < length treeList ∧ ¬ (x = mi ∨ x = ma)")
case True
hence 1: "T⇩i⇩n⇩s⇩e⇩r⇩t' (Node (Some (mi,ma)) deg treeList summary) x =
T⇩i⇩n⇩s⇩e⇩r⇩t' (treeList ! ?h) ?l +
(if minNull (treeList ! ?h) then T⇩i⇩n⇩s⇩e⇩r⇩t' summary ?h else 1)"
using 0 by simp
then show ?thesis
proof(cases " minNull (treeList ! ?h)")
case True
hence " T⇩i⇩n⇩s⇩e⇩r⇩t' (treeList ! ?h) ?l ≤ 1"
by (smt (z3) "0" "1" "4.IH"(1) insertsimp' le_add1 nat_add_left_cancel_le nth_mem numeral_3_eq_3 order_trans plus_1_eq_Suc)
hence 2: "T⇩i⇩n⇩s⇩e⇩r⇩t' (Node (Some (mi,ma)) deg treeList summary) x ≤ 1+
(if minNull (treeList ! ?h) then T⇩i⇩n⇩s⇩e⇩r⇩t' summary ?h else 1)"
using 1 algebra_simps by simp
hence "T⇩i⇩n⇩s⇩e⇩r⇩t' (Node (Some (mi,ma)) deg treeList summary) x ≤ 1 + T⇩i⇩n⇩s⇩e⇩r⇩t' summary ?h" using True by simp
then show ?thesis using height_compose_summary[of summary "Some (mi, ma)" deg treeList] algebra_simps
by (smt (z3) "1" "4.IH"(2) True ‹T⇩i⇩n⇩s⇩e⇩r⇩t' (treeList ! high (if x < mi then mi else x) (deg div 2)) (low (if x < mi then mi else x) (deg div 2)) ≤ 1› add_mono order_trans)
next
case False
hence 2:"T⇩i⇩n⇩s⇩e⇩r⇩t' (Node (Some (mi,ma)) deg treeList summary) x = 1+
T⇩i⇩n⇩s⇩e⇩r⇩t' (treeList ! ?h) ?l" using 1 by simp
hence "T⇩i⇩n⇩s⇩e⇩r⇩t' (Node (Some (mi,ma)) deg treeList summary) x ≤ 1+ T⇩i⇩n⇩s⇩e⇩r⇩t' (treeList ! ?h) ?l "
using minNull_bound[of "treeList ! ?h"] algebra_simps by linarith
hence "T⇩i⇩n⇩s⇩e⇩r⇩t' (Node (Some (mi,ma)) deg treeList summary) x ≤ 1+ (1+ height (treeList ! ?h))"
by (meson "4.IH"(1) True nat_add_left_cancel_le nth_mem order_trans)
moreover have " (treeList!?h) ∈ set treeList"
using True nth_mem by blast
ultimately show ?thesis using height_compose_child[of "treeList!?h" treeList "Some (mi, ma)" deg summary] algebra_simps
by (smt (verit, ccfv_SIG) Suc_leI add.right_neutral le_add1 le_imp_less_Suc mult_le_mono order_trans plus_1_eq_Suc)
qed
next
case False
then show ?thesis
using "0" by force
qed
qed
next
case (5 treeList n summary m deg mi ma)
hence "deg ≥ 2"
by (metis Suc_1 add_mono le_add1 plus_1_eq_Suc set_n_deg_not_0)
let ?xn = "(if x < mi then mi else x)"
let ?minn = "(if x< mi then x else mi)"
let ?l= "low ?xn (deg div 2)"
let ?h = "high ?xn (deg div 2)"
show ?case
proof(cases "x < mi")
case True
hence 0:"T⇩i⇩n⇩s⇩e⇩r⇩t' (Node (Some (mi,ma)) deg treeList summary) x =
( if ?h < length treeList ∧ ¬ (x = mi ∨ x = ma)then
T⇩i⇩n⇩s⇩e⇩r⇩t' (treeList ! ?h) ?l +
(if minNull (treeList ! ?h) then T⇩i⇩n⇩s⇩e⇩r⇩t' summary ?h else 1)
else 1)" using T⇩i⇩n⇩s⇩e⇩r⇩t'.simps(5)[of mi ma "deg -2 " treeList summary x]
by (smt (z3) ‹2 ≤ deg› add_2_eq_Suc le_add_diff_inverse)
then show ?thesis
proof(cases " ?h < length treeList ∧ ¬ (x = mi ∨ x = ma)")
case True
hence 1: "T⇩i⇩n⇩s⇩e⇩r⇩t' (Node (Some (mi,ma)) deg treeList summary) x =
T⇩i⇩n⇩s⇩e⇩r⇩t' (treeList ! ?h) ?l + (if minNull (treeList ! ?h) then T⇩i⇩n⇩s⇩e⇩r⇩t' summary ?h else 1)"
using 0 by simp
then show ?thesis
proof(cases " minNull (treeList ! ?h)")
case True
hence " T⇩i⇩n⇩s⇩e⇩r⇩t' (treeList ! ?h) ?l ≤ 1"
by (metis "0" "1" "5.IH"(1) insertsimp' nat_le_iff_add nth_mem)
hence 2: "T⇩i⇩n⇩s⇩e⇩r⇩t' (Node (Some (mi,ma)) deg treeList summary) x ≤ 1+
(if minNull (treeList ! ?h) then T⇩i⇩n⇩s⇩e⇩r⇩t' summary ?h else 1)"
using 1 algebra_simps by simp
hence "T⇩i⇩n⇩s⇩e⇩r⇩t' (Node (Some (mi,ma)) deg treeList summary) x ≤ 1 + T⇩i⇩n⇩s⇩e⇩r⇩t' summary ?h"
using True by simp
hence "T⇩i⇩n⇩s⇩e⇩r⇩t' (Node (Some (mi,ma)) deg treeList summary) x ≤ 1 + (height summary +1)"
using "5.IH"(2) "1" ‹T⇩i⇩n⇩s⇩e⇩r⇩t' (treeList ! high (if x < mi then mi else x) (deg div 2))
(low (if x < mi then mi else x) (deg div 2)) ≤ 1› add_mono_thms_linordered_semiring(1)
by fastforce
then show ?thesis using height_compose_summary[of summary "Some (mi, ma)" deg treeList] algebra_simps by linarith
next
case False
hence 2:"T⇩i⇩n⇩s⇩e⇩r⇩t' (Node (Some (mi,ma)) deg treeList summary) x =
1+ T⇩i⇩n⇩s⇩e⇩r⇩t' (treeList ! ?h) ?l " using 1 by simp
hence "T⇩i⇩n⇩s⇩e⇩r⇩t' (Node (Some (mi,ma)) deg treeList summary) x ≤ 1+ (1+ height (treeList ! ?h))"
using "5.IH"(1) True by force
moreover have " (treeList!?h) ∈ set treeList"
using True nth_mem by blast
ultimately show ?thesis using height_compose_child[of "treeList!?h" treeList "Some (mi, ma)" deg summary] algebra_simps
by (smt (verit, ccfv_SIG) Suc_leI add.right_neutral le_add1 le_imp_less_Suc mult_le_mono order_trans plus_1_eq_Suc)
qed
next
case False
then show ?thesis using "0" Suc_eq_plus1 le_add2 plus_1_eq_Suc by presburger
qed
next
case False
hence 0:"T⇩i⇩n⇩s⇩e⇩r⇩t' (Node (Some (mi,ma)) deg treeList summary) x =
( if ?h < length treeList ∧ ¬ (x = mi ∨ x = ma)then
T⇩i⇩n⇩s⇩e⇩r⇩t' (treeList ! ?h) ?l + (if minNull (treeList ! ?h) then T⇩i⇩n⇩s⇩e⇩r⇩t' summary ?h else 1) else 1)"
using T⇩i⇩n⇩s⇩e⇩r⇩t'.simps(5)[of mi ma "deg -2 " treeList summary x]
by (smt (z3) ‹2 ≤ deg› add_2_eq_Suc le_add_diff_inverse)
then show ?thesis
proof(cases " ?h < length treeList ∧ ¬ (x = mi ∨ x = ma)")
case True
hence 1: "T⇩i⇩n⇩s⇩e⇩r⇩t' (Node (Some (mi,ma)) deg treeList summary) x =
T⇩i⇩n⇩s⇩e⇩r⇩t' (treeList ! ?h) ?l + (if minNull (treeList ! ?h) then T⇩i⇩n⇩s⇩e⇩r⇩t' summary ?h else 1)"
using 0 by simp
then show ?thesis
proof(cases " minNull (treeList ! ?h)")
case True
hence " T⇩i⇩n⇩s⇩e⇩r⇩t' (treeList ! ?h) ?l ≤ 1"
by (smt (z3) "0" "1" "5.IH"(1) insertsimp' le_add1 nat_add_left_cancel_le nth_mem numeral_3_eq_3 order_trans plus_1_eq_Suc)
hence 2: "T⇩i⇩n⇩s⇩e⇩r⇩t' (Node (Some (mi,ma)) deg treeList summary) x ≤ 1+
(if minNull (treeList ! ?h) then T⇩i⇩n⇩s⇩e⇩r⇩t' summary ?h else 1)"
using 1 algebra_simps by simp
hence "T⇩i⇩n⇩s⇩e⇩r⇩t' (Node (Some (mi,ma)) deg treeList summary) x ≤ 1 + T⇩i⇩n⇩s⇩e⇩r⇩t' summary ?h"
using True by simp
then show ?thesis
using height_compose_summary[of summary "Some (mi, ma)" deg treeList] algebra_simps
by (smt (z3) "1" "5.IH"(2) True ‹T⇩i⇩n⇩s⇩e⇩r⇩t' (treeList ! high (if x < mi then mi else x) (deg div 2)) (low (if x < mi then mi else x) (deg div 2)) ≤ 1› add_mono order_trans)
next
case False
hence 2:"T⇩i⇩n⇩s⇩e⇩r⇩t' (Node (Some (mi,ma)) deg treeList summary) x = 1+
T⇩i⇩n⇩s⇩e⇩r⇩t' (treeList ! ?h) ?l" using 1 by simp
hence "T⇩i⇩n⇩s⇩e⇩r⇩t' (Node (Some (mi,ma)) deg treeList summary) x ≤ 1+ T⇩i⇩n⇩s⇩e⇩r⇩t' (treeList ! ?h) ?l "
using minNull_bound[of "treeList ! ?h"] algebra_simps by linarith
hence "T⇩i⇩n⇩s⇩e⇩r⇩t' (Node (Some (mi,ma)) deg treeList summary) x ≤ 1+ (1+ height (treeList ! ?h))"
by (meson "5.IH"(1) True nat_add_left_cancel_le nth_mem order_trans)
moreover have " (treeList!?h) ∈ set treeList"
using True nth_mem by blast
ultimately show ?thesis using height_compose_child[of "treeList!?h" treeList "Some (mi, ma)" deg summary] algebra_simps
by (smt (verit, ccfv_SIG) Suc_leI add.right_neutral le_add1 le_imp_less_Suc mult_le_mono order_trans plus_1_eq_Suc)
qed
next
case False
then show ?thesis
using "0" by force
qed
qed
qed simp+
subsection ‹Successor Function›
fun T⇩s⇩u⇩c⇩c::"VEBT ⇒ nat ⇒ nat" where
"T⇩s⇩u⇩c⇩c (Leaf _ b) 0 = 1+ (if b then 1 else 1)"|
"T⇩s⇩u⇩c⇩c (Leaf _ _) (Suc n) = 1"|
"T⇩s⇩u⇩c⇩c (Node None _ _ _) _ = 1"|
"T⇩s⇩u⇩c⇩c (Node _ 0 _ _) _ = 1"|
"T⇩s⇩u⇩c⇩c (Node _ (Suc 0) _ _) _ = 1"|
"T⇩s⇩u⇩c⇩c (Node (Some (mi, ma)) deg treeList summary) x = 1+ (
if x < mi then 1
else (let l = low x (deg div 2); h = high x (deg div 2) in 10 +
(if h < length treeList then 1+ T⇩m⇩a⇩x⇩t (treeList ! h) + (
let maxlow = vebt_maxt (treeList ! h) in 3 +
(if maxlow ≠ None ∧ (Some l <⇩o maxlow) then
4 + T⇩s⇩u⇩c⇩c (treeList ! h) l
else let sc = vebt_succ summary h in 1+ T⇩s⇩u⇩c⇩c summary h + 1 + (
if sc = None then 1
else (4 + T⇩m⇩i⇩n⇩t (treeList ! the sc) ))))
else 1)))"
fun T⇩s⇩u⇩c⇩c'::"VEBT ⇒ nat ⇒ nat" where
"T⇩s⇩u⇩c⇩c' (Leaf _ b) 0 = 1"|
"T⇩s⇩u⇩c⇩c' (Leaf _ _) (Suc n) = 1"|
"T⇩s⇩u⇩c⇩c' (Node None _ _ _) _ = 1"|
"T⇩s⇩u⇩c⇩c' (Node _ 0 _ _) _ = 1"|
"T⇩s⇩u⇩c⇩c' (Node _ (Suc 0) _ _) _ = 1"|
"T⇩s⇩u⇩c⇩c' (Node (Some (mi, ma)) deg treeList summary) x =(
if x < mi then 1
else (let l = low x (deg div 2); h = high x (deg div 2) in
(if h < length treeList then (
let maxlow = vebt_maxt (treeList ! h) in
(if maxlow ≠ None ∧ (Some l <⇩o maxlow) then
1+ T⇩s⇩u⇩c⇩c' (treeList ! h) l
else let sc = vebt_succ summary h in T⇩s⇩u⇩c⇩c' summary h + (
if sc = None then 1
else 1 )))
else 1)))"
theorem succ_bound_height: "invar_vebt t n ⟹ T⇩s⇩u⇩c⇩c t x ≤ (1+height t)*27"
proof(induction t n arbitrary: x rule: invar_vebt.induct)
case (1 a b)
then show ?case using T⇩s⇩u⇩c⇩c.simps(1)[of a b]
proof -
have "∀b v ba n. T⇩s⇩u⇩c⇩c v n = 1 ∨ Leaf b ba ≠ v ∨ 0 = n"
using T⇩s⇩u⇩c⇩c.elims by blast
then show ?thesis
by (metis (no_types) Nat.add_0_right ‹T⇩s⇩u⇩c⇩c (Leaf a b) 0 = 1 + (if b then 1 else 1)› height.simps(1) nat_mult_1 numeral_le_iff one_add_one one_le_numeral semiring_norm(68) semiring_norm(72))
qed
next
case (2 treeList n summary m deg)
then show ?case by simp
next
case (3 treeList n summary m deg)
then show ?case by simp
next
case (4 treeList n summary m deg mi ma)
hence "deg ≥ 2"
by (metis add_self_div_2 deg_not_0 div_greater_zero_iff)
then show ?case
proof(cases "x < mi")
case True
then show ?thesis using T⇩s⇩u⇩c⇩c.simps(6)[of mi ma "deg-2" treeList summary x]
by (smt (z3) Suc_leI ‹2 ≤ deg› add_2_eq_Suc distrib_right le_add_diff_inverse linorder_not_less mult.left_neutral numeral_le_one_iff plus_1_eq_Suc semiring_norm(70) trans_le_add1)
next
case False
let ?l = "low x (deg div 2)"
let ?h = "high x (deg div 2)"
show ?thesis
proof(cases "?h < length treeList")
case True
hence "?h < length treeList" by simp
hence 0:"T⇩s⇩u⇩c⇩c (Node (Some (mi, ma)) deg treeList summary) x =12 + T⇩m⇩a⇩x⇩t (treeList ! ?h) + (
let maxlow = vebt_maxt (treeList ! ?h) in 3 +
(if maxlow ≠ None ∧ (Some ?l <⇩o maxlow) then
4 + T⇩s⇩u⇩c⇩c (treeList ! ?h) ?l
else let sc = vebt_succ summary ?h in 1+ T⇩s⇩u⇩c⇩c summary ?h + 1 + (
if sc = None then 1
else (4 + T⇩m⇩i⇩n⇩t (treeList ! the sc) ))))" using
T⇩s⇩u⇩c⇩c.simps(6)[of mi ma "deg-2" treeList summary x] False True
by (smt (z3) ‹2 ≤ deg› add.commute add.left_commute add_2_eq_Suc' le_add_diff_inverse numeral_plus_one semiring_norm(5) semiring_norm(8))
let ?maxlow= "vebt_maxt (treeList ! ?h)"
let ?sc="vebt_succ summary ?h"
have 1:"T⇩s⇩u⇩c⇩c (Node (Some (mi, ma)) deg treeList summary) x =15 + T⇩m⇩a⇩x⇩t (treeList ! ?h) +
(if ?maxlow ≠ None ∧ (Some ?l <⇩o ?maxlow) then
4 + T⇩s⇩u⇩c⇩c (treeList ! ?h) ?l
else 2+ T⇩s⇩u⇩c⇩c summary ?h + (
if ?sc = None then 1
else (4 + T⇩m⇩i⇩n⇩t (treeList ! the ?sc))))" using 0 by auto
then show ?thesis
proof(cases " ?maxlow ≠ None ∧ (Some ?l <⇩o ?maxlow)")
case True
hence "T⇩s⇩u⇩c⇩c (Node (Some (mi, ma)) deg treeList summary) x =
19 + T⇩m⇩a⇩x⇩t (treeList ! ?h) + T⇩s⇩u⇩c⇩c (treeList ! ?h) ?l"
using 1 by simp
hence "T⇩s⇩u⇩c⇩c (Node (Some (mi, ma)) deg treeList summary) x ≤
22 + T⇩s⇩u⇩c⇩c (treeList ! ?h) ?l" using maxt_bound[of "treeList ! ?h"]
by simp
moreover have a:"treeList ! ?h ∈ set treeList "
by (simp add: ‹high x (deg div 2) < length treeList›)
ultimately have "T⇩s⇩u⇩c⇩c (Node (Some (mi, ma)) deg treeList summary) x ≤
22 + (1+ height (treeList ! ?h))*27"
by (meson "4.IH"(1) nat_add_left_cancel_le order_trans)
hence "T⇩s⇩u⇩c⇩c (Node (Some (mi, ma)) deg treeList summary) x ≤
((1+ height (treeList ! ?h))+1)*27" by simp
then show ?thesis
using height_compose_child[of "treeList ! ?h" treeList "Some (mi, ma)" deg summary] a
by (smt (z3) Suc_leI add.commute dual_order.strict_trans2 le_imp_less_Suc linorder_not_less mult.commute mult_le_mono2 plus_1_eq_Suc)
next
case False
have 2:"T⇩s⇩u⇩c⇩c (Node (Some (mi, ma)) deg treeList summary) x =17 + T⇩m⇩a⇩x⇩t (treeList ! ?h) +
T⇩s⇩u⇩c⇩c summary ?h + (
if ?sc = None then 1
else (4 + T⇩m⇩i⇩n⇩t (treeList ! the ?sc)))" using 1
by (smt (z3) False Suc_eq_plus1 add.assoc add.commute add_2_eq_Suc' eval_nat_numeral(3) numeral_plus_one semiring_norm(2) semiring_norm(8))
then show ?thesis
proof(cases " ?sc = None")
case True
hence 3:"T⇩s⇩u⇩c⇩c (Node (Some (mi, ma)) deg treeList summary) x =
18 + T⇩m⇩a⇩x⇩t (treeList ! ?h) + T⇩s⇩u⇩c⇩c summary ?h "
using 2 by simp
hence "T⇩s⇩u⇩c⇩c (Node (Some (mi, ma)) deg treeList summary) x ≤ 21 + T⇩s⇩u⇩c⇩c summary ?h"
using maxt_bound[of "treeList ! ?h"] by simp
hence "T⇩s⇩u⇩c⇩c (Node (Some (mi, ma)) deg treeList summary) x ≤ 21 + (1+ height summary)*27"
by (metis "3" "4.IH"(2) add_le_cancel_right add_le_mono)
then show ?thesis using height_compose_summary[of summary "Some (mi, ma)" deg treeList] by presburger
next
case False
hence 3:"T⇩s⇩u⇩c⇩c (Node (Some (mi, ma)) deg treeList summary) x =21 + T⇩m⇩a⇩x⇩t (treeList ! ?h) +
T⇩s⇩u⇩c⇩c summary ?h + T⇩m⇩i⇩n⇩t (treeList ! the ?sc)" using 2 by simp
hence "T⇩s⇩u⇩c⇩c (Node (Some (mi, ma)) deg treeList summary) x ≤ 27+ T⇩s⇩u⇩c⇩c summary ?h "
using maxt_bound[of "treeList ! ?h"] mint_bound[of "treeList ! the ?sc"] by simp
hence "T⇩s⇩u⇩c⇩c (Node (Some (mi, ma)) deg treeList summary) x ≤ 27+ (1+height summary)*27"
by (meson "4.IH"(2) add_mono_thms_linordered_semiring(2) dual_order.trans)
hence "T⇩s⇩u⇩c⇩c (Node (Some (mi, ma)) deg treeList summary) x ≤ ((1+height summary)+1)*27" by simp
hence "T⇩s⇩u⇩c⇩c (Node (Some (mi, ma)) deg treeList summary) x ≤ (height (Node (Some (mi, ma)) deg treeList summary) + 1)*27"
using height_compose_summary[of summary "Some (mi, ma)" deg treeList]
by (simp add: ‹1 + height summary ≤ height (Node (Some (mi, ma)) deg treeList summary)› ‹T⇩s⇩u⇩c⇩c (Node (Some (mi, ma)) deg treeList summary) x ≤ (1 + height summary + 1) * 27› add.commute add_mono le_numeral_extra(4) le_trans mult.commute mult_le_mono2)
then show ?thesis by simp
qed
qed
next
case False
hence " T⇩s⇩u⇩c⇩c (Node (Some (mi, ma)) deg treeList summary) x = 12"
using T⇩s⇩u⇩c⇩c.simps(6)[of mi ma "deg-2" treeList summary x]
by (smt (z3) "4.hyps"(2) "4.hyps"(3) "4.hyps"(4) "4.hyps"(7) "4.hyps"(8) ‹2 ≤ deg› add_Suc add_self_div_2 dual_order.strict_trans2 high_bound_aux le_add_diff_inverse less_imp_le_nat numeral_plus_one numerals(1) plus_1_eq_Suc semiring_norm(2) semiring_norm(5) semiring_norm(8))
then show ?thesis
by auto
qed
qed
next
case (5 treeList n summary m deg mi ma)
hence "deg ≥ 2"
by (metis Suc_1 add_mono_thms_linordered_semiring(1) le_add1 plus_1_eq_Suc set_n_deg_not_0)
then show ?case
proof(cases "x < mi")
case True
then show ?thesis
using T⇩s⇩u⇩c⇩c.simps(6)[of mi ma "deg-2" treeList summary x]
by (smt (z3) Suc_leI ‹2 ≤ deg› add_2_eq_Suc distrib_right le_add_diff_inverse linorder_not_less mult.left_neutral numeral_le_one_iff plus_1_eq_Suc semiring_norm(70) trans_le_add1)
next
case False
let ?l = "low x (deg div 2)"
let ?h = "high x (deg div 2)"
show ?thesis
proof(cases "?h < length treeList")
case True
hence "?h < length treeList" by simp
hence 0:"T⇩s⇩u⇩c⇩c (Node (Some (mi, ma)) deg treeList summary) x =12 + T⇩m⇩a⇩x⇩t (treeList ! ?h) + (
let maxlow = vebt_maxt (treeList ! ?h) in 3 +
(if maxlow ≠ None ∧ (Some ?l <⇩o maxlow) then
4 + T⇩s⇩u⇩c⇩c (treeList ! ?h) ?l
else let sc = vebt_succ summary ?h in 1+ T⇩s⇩u⇩c⇩c summary ?h + 1 + (
if sc = None then 1
else (4 + T⇩m⇩i⇩n⇩t (treeList ! the sc) ))))" using
T⇩s⇩u⇩c⇩c.simps(6)[of mi ma "deg-2" treeList summary x] False True
by (smt (z3) ‹2 ≤ deg› add.commute add.left_commute add_2_eq_Suc' le_add_diff_inverse numeral_plus_one semiring_norm(5) semiring_norm(8))
let ?maxlow= "vebt_maxt (treeList ! ?h)"
let ?sc="vebt_succ summary ?h"
have 1:"T⇩s⇩u⇩c⇩c (Node (Some (mi, ma)) deg treeList summary) x =15 + T⇩m⇩a⇩x⇩t (treeList ! ?h) +
(if ?maxlow ≠ None ∧ (Some ?l <⇩o ?maxlow) then
4 + T⇩s⇩u⇩c⇩c (treeList ! ?h) ?l
else 2+ T⇩s⇩u⇩c⇩c summary ?h + (
if ?sc = None then 1
else (4 + T⇩m⇩i⇩n⇩t (treeList ! the ?sc))))" using 0 by auto
then show ?thesis
proof(cases " ?maxlow ≠ None ∧ (Some ?l <⇩o ?maxlow)")
case True
hence "T⇩s⇩u⇩c⇩c (Node (Some (mi, ma)) deg treeList summary) x =
19 + T⇩m⇩a⇩x⇩t (treeList ! ?h) + T⇩s⇩u⇩c⇩c (treeList ! ?h) ?l" using 1 by simp
hence "T⇩s⇩u⇩c⇩c (Node (Some (mi, ma)) deg treeList summary) x ≤
22 + T⇩s⇩u⇩c⇩c (treeList ! ?h) ?l" using maxt_bound[of "treeList ! ?h"] by simp
moreover have a:"treeList ! ?h ∈ set treeList "
by (simp add: ‹high x (deg div 2) < length treeList›)
ultimately have "T⇩s⇩u⇩c⇩c (Node (Some (mi, ma)) deg treeList summary) x ≤
22 + (1+ height (treeList ! ?h))*27"
by (meson "5.IH"(1) nat_add_left_cancel_le order_trans)
hence "T⇩s⇩u⇩c⇩c (Node (Some (mi, ma)) deg treeList summary) x ≤
((1+ height (treeList ! ?h))+1)*27" by simp
then show ?thesis using height_compose_child[of "treeList ! ?h" treeList "Some (mi, ma)" deg summary] a
by (smt (z3) Suc_leI add.commute dual_order.strict_trans2 le_imp_less_Suc linorder_not_less mult.commute mult_le_mono2 plus_1_eq_Suc)
next
case False
have 2:"T⇩s⇩u⇩c⇩c (Node (Some (mi, ma)) deg treeList summary) x =17 + T⇩m⇩a⇩x⇩t (treeList ! ?h) +
T⇩s⇩u⇩c⇩c summary ?h + (
if ?sc = None then 1
else (4 + T⇩m⇩i⇩n⇩t (treeList ! the ?sc)))" using 1
by (smt (z3) False Suc_eq_plus1 add.assoc add.commute add_2_eq_Suc' eval_nat_numeral(3) numeral_plus_one semiring_norm(2) semiring_norm(8))
then show ?thesis
proof(cases " ?sc = None")
case True
hence 3:"T⇩s⇩u⇩c⇩c (Node (Some (mi, ma)) deg treeList summary) x =18 + T⇩m⇩a⇩x⇩t (treeList ! ?h) +
T⇩s⇩u⇩c⇩c summary ?h " using 2 by simp
hence "T⇩s⇩u⇩c⇩c (Node (Some (mi, ma)) deg treeList summary) x ≤ 21 + T⇩s⇩u⇩c⇩c summary ?h"
using maxt_bound[of "treeList ! ?h"] by simp
hence "T⇩s⇩u⇩c⇩c (Node (Some (mi, ma)) deg treeList summary) x ≤ 21 + (1+ height summary)*27"
by (metis "3" "5.IH"(2) add_le_cancel_right add_le_mono)
then show ?thesis using height_compose_summary[of summary "Some (mi, ma)" deg treeList] by presburger
next
case False
hence 3:"T⇩s⇩u⇩c⇩c (Node (Some (mi, ma)) deg treeList summary) x =21 + T⇩m⇩a⇩x⇩t (treeList ! ?h) +
T⇩s⇩u⇩c⇩c summary ?h + T⇩m⇩i⇩n⇩t (treeList ! the ?sc)" using 2 by simp
hence "T⇩s⇩u⇩c⇩c (Node (Some (mi, ma)) deg treeList summary) x ≤ 27+ T⇩s⇩u⇩c⇩c summary ?h "
using maxt_bound[of "treeList ! ?h"] mint_bound[of "treeList ! the ?sc"] by simp
hence "T⇩s⇩u⇩c⇩c (Node (Some (mi, ma)) deg treeList summary) x ≤ 27+ (1+height summary)*27"
by (meson "5.IH"(2) add_mono_thms_linordered_semiring(2) dual_order.trans)
hence "T⇩s⇩u⇩c⇩c (Node (Some (mi, ma)) deg treeList summary) x ≤ ((1+height summary)+1)*27" by simp
hence "T⇩s⇩u⇩c⇩c (Node (Some (mi, ma)) deg treeList summary) x ≤ (height (Node (Some (mi, ma)) deg treeList summary) + 1)*27"
using height_compose_summary[of summary "Some (mi, ma)" deg treeList]
by (simp add: ‹1 + height summary ≤ height (Node (Some (mi, ma)) deg treeList summary)› ‹T⇩s⇩u⇩c⇩c (Node (Some (mi, ma)) deg treeList summary) x ≤ (1 + height summary + 1) * 27› add.commute add_mono le_numeral_extra(4) le_trans mult.commute mult_le_mono2)
then show ?thesis by simp
qed
qed
next
case False
hence " T⇩s⇩u⇩c⇩c (Node (Some (mi, ma)) deg treeList summary) x = 12" using
T⇩s⇩u⇩c⇩c.simps(6)[of mi ma "deg-2" treeList summary x] "5.hyps"(2) "5.hyps"(3) "5.hyps"(4)
"5.hyps"(7) "5.hyps"(8) ‹2 ≤ deg› add_Suc add_self_div_2 dual_order.strict_trans2
high_bound_aux le_add_diff_inverse less_imp_le_nat numeral_plus_one numerals(1)
plus_1_eq_Suc semiring_norm(2) semiring_norm(5) semiring_norm(8) apply auto
by (smt (z3) "5.hyps"(4) le_less_trans less_trans power_Suc)
then show ?thesis
by auto
qed
qed
qed
theorem succ_bound_size_univ: "invar_vebt t n ⟹ u = 2^n ⟹ T⇩s⇩u⇩c⇩c t x ≤ 54 + 27 * lb (lb u)"
using succ_bound_height[of t n x] height_double_log_univ_size[of u n t] by simp
theorem succ'_bound_height: "invar_vebt t n ⟹ T⇩s⇩u⇩c⇩c' t x ≤ (1+height t)"
proof(induction t n arbitrary: x rule: invar_vebt.induct)
case (1 a b)
then show ?case
by (metis One_nat_def T⇩s⇩u⇩c⇩c'.simps(1) T⇩s⇩u⇩c⇩c'.simps(2) height.simps(1) le_add2 le_add_same_cancel2 le_neq_implies_less less_imp_Suc_add order_refl plus_1_eq_Suc)
next
case (4 treeList n summary m deg mi ma)
hence degprop: "deg ≥ 2"
by (metis add_self_div_2 deg_not_0 div_greater_zero_iff)
then show ?case
proof(cases "x< mi")
case True
then show ?thesis using T⇩s⇩u⇩c⇩c'.simps(6)[of mi ma "deg-2" treeList summary x] degprop
by (metis add_2_eq_Suc le_add_diff_inverse le_numeral_extra(4) trans_le_add1)
next
case False
hence "x ≥ mi" by simp
let ?l = "low x (deg div 2)"
let ?h = "high x (deg div 2)"
show ?thesis
proof(cases "?h < length treeList")
case True
hence hprop: "?h < length treeList" by simp
let ?maxlow = "vebt_maxt (treeList ! ?h)"
show ?thesis
proof(cases " ?maxlow ≠ None ∧ (Some ?l <⇩o ?maxlow)")
case True
hence "T⇩s⇩u⇩c⇩c' (Node (Some (mi, ma)) deg treeList summary) x = 1+ T⇩s⇩u⇩c⇩c' (treeList ! ?h) ?l"
using T⇩s⇩u⇩c⇩c'.simps(6)[of mi ma "deg-2" treeList summary x] degprop hprop
by (smt (z3) False add_2_eq_Suc le_add_diff_inverse)
moreover have " (treeList ! ?h) ∈ set treeList"
using hprop nth_mem by blast
moreover have " T⇩s⇩u⇩c⇩c' (treeList ! ?h) ?l ≤ 1+ height (treeList ! ?h)" using 4(1) calculation by blast
ultimately have "T⇩s⇩u⇩c⇩c' (Node (Some (mi, ma)) deg treeList summary) x ≤ 1 + 1+ height (treeList ! ?h)" by simp
then show ?thesis
by (smt (z3) Suc_le_mono ‹T⇩s⇩u⇩c⇩c' (Node (Some (mi, ma)) deg treeList summary) x = 1 + T⇩s⇩u⇩c⇩c' (treeList ! high x (deg div 2)) (low x (deg div 2))› ‹T⇩s⇩u⇩c⇩c' (treeList ! high x (deg div 2)) (low x (deg div 2)) ≤ 1 + height (treeList ! high x (deg div 2))› ‹treeList ! high x (deg div 2) ∈ set treeList› height_compose_child le_trans plus_1_eq_Suc)
next
case False
hence "T⇩s⇩u⇩c⇩c' (Node (Some (mi, ma)) deg treeList summary) x = 1+ T⇩s⇩u⇩c⇩c' summary ?h"
using T⇩s⇩u⇩c⇩c'.simps(6)[of mi ma "deg-2" treeList summary x] degprop hprop
apply(cases " vebt_succ summary ?h") using False add_2_eq_Suc le_add_diff_inverse
apply (smt (z3) Suc_eq_plus1 ‹mi ≤ x› linorder_not_less plus_1_eq_Suc)+
done
moreover have " T⇩s⇩u⇩c⇩c' summary ?h ≤ 1+ height summary" using 4(2) calculation by blast
ultimately have "T⇩s⇩u⇩c⇩c' (Node (Some (mi, ma)) deg treeList summary) x ≤ 1 + 1+ height summary" by simp
then show ?thesis
by (simp add: le_trans)
qed
next
case False
then show ?thesis using T⇩s⇩u⇩c⇩c'.simps(6)[of mi ma "deg-2" treeList summary x] degprop
by (smt (z3) add_2_eq_Suc leI le_add_diff_inverse not_add_less1)
qed
qed
next
case (5 treeList n summary m deg mi ma)
hence degprop: "deg ≥ 2"
by (metis Suc_1 add_mono le_add1 plus_1_eq_Suc set_n_deg_not_0)
then show ?case
proof(cases "x< mi")
case True
then show ?thesis using T⇩s⇩u⇩c⇩c'.simps(6)[of mi ma "deg-2" treeList summary x] degprop
by (metis add_2_eq_Suc le_add_diff_inverse le_numeral_extra(4) trans_le_add1)
next
case False
hence "x ≥ mi" by simp
let ?l = "low x (deg div 2)"
let ?h = "high x (deg div 2)"
show ?thesis
proof(cases "?h < length treeList")
case True
hence hprop: "?h < length treeList" by simp
let ?maxlow = "vebt_maxt (treeList ! ?h)"
show ?thesis
proof(cases " ?maxlow ≠ None ∧ (Some ?l <⇩o ?maxlow)")
case True
hence "T⇩s⇩u⇩c⇩c' (Node (Some (mi, ma)) deg treeList summary) x = 1+ T⇩s⇩u⇩c⇩c' (treeList ! ?h) ?l"
using T⇩s⇩u⇩c⇩c'.simps(6)[of mi ma "deg-2" treeList summary x] degprop hprop
by (smt (z3) False add_2_eq_Suc le_add_diff_inverse)
moreover have " (treeList ! ?h) ∈ set treeList"
using hprop nth_mem by blast
moreover have " T⇩s⇩u⇩c⇩c' (treeList ! ?h) ?l ≤ 1+ height (treeList ! ?h)" using 5(1) calculation by blast
ultimately have "T⇩s⇩u⇩c⇩c' (Node (Some (mi, ma)) deg treeList summary) x ≤ 1 + 1+ height (treeList ! ?h)" by simp
then show ?thesis
by (smt (z3) Suc_le_mono ‹T⇩s⇩u⇩c⇩c' (Node (Some (mi, ma)) deg treeList summary) x = 1 + T⇩s⇩u⇩c⇩c' (treeList ! high x (deg div 2)) (low x (deg div 2))› ‹T⇩s⇩u⇩c⇩c' (treeList ! high x (deg div 2)) (low x (deg div 2)) ≤ 1 + height (treeList ! high x (deg div 2))› ‹treeList ! high x (deg div 2) ∈ set treeList› height_compose_child le_trans plus_1_eq_Suc)
next
case False
hence "T⇩s⇩u⇩c⇩c' (Node (Some (mi, ma)) deg treeList summary) x = 1+ T⇩s⇩u⇩c⇩c' summary ?h"
using T⇩s⇩u⇩c⇩c'.simps(6)[of mi ma "deg-2" treeList summary x] degprop hprop
by (cases " vebt_succ summary ?h")
(smt (z3) Suc_eq_plus1 ‹mi ≤ x› linorder_not_less plus_1_eq_Suc False add_2_eq_Suc le_add_diff_inverse)+
moreover have " T⇩s⇩u⇩c⇩c' summary ?h ≤ 1+ height summary" using 5(2) calculation by blast
ultimately have "T⇩s⇩u⇩c⇩c' (Node (Some (mi, ma)) deg treeList summary) x ≤ 1 + 1+ height summary" by simp
then show ?thesis
by (simp add: le_trans)
qed
next
case False
then show ?thesis using T⇩s⇩u⇩c⇩c'.simps(6)[of mi ma "deg-2" treeList summary x] degprop
by (smt (z3) add_2_eq_Suc leI le_add_diff_inverse not_add_less1)
qed
qed
qed simp+
theorem succ_bound_size_univ': "invar_vebt t n ⟹ u = 2^n ⟹ T⇩s⇩u⇩c⇩c' t x ≤ 2 + lb (lb u)"
using succ'_bound_height[of t n x] height_double_log_univ_size[of u n t] by simp
subsection ‹Predecessor Function›
fun T⇩p⇩r⇩e⇩d::"VEBT ⇒ nat ⇒ nat " where
"T⇩p⇩r⇩e⇩d (Leaf _ _) 0 = 1"|
"T⇩p⇩r⇩e⇩d (Leaf a _) (Suc 0) = 1+ (if a then 1 else 1)"|
"T⇩p⇩r⇩e⇩d (Leaf a b) _ = 1+ (if b then 1 else 1+ (if a then 1 else 1))"|
"T⇩p⇩r⇩e⇩d (Node None _ _ _) _ = 1"|
"T⇩p⇩r⇩e⇩d (Node _ 0 _ _) _ = 1"|
"T⇩p⇩r⇩e⇩d (Node _ (Suc 0) _ _) _ = 1"|
"T⇩p⇩r⇩e⇩d (Node (Some (mi, ma)) deg treeList summary) x = 1+ (
if x > ma then 1
else (let l = low x (deg div 2); h = high x (deg div 2) in 10 + 1+
(if h < length treeList then
let minlow = vebt_mint (treeList ! h) in 2 + T⇩m⇩i⇩n⇩t(treeList ! h) + 3 +
(if minlow ≠ None ∧ (Some l >⇩o minlow) then
4 + T⇩p⇩r⇩e⇩d (treeList ! h) l
else let pr = vebt_pred summary h in 1 + T⇩p⇩r⇩e⇩d summary h+ 1 + (
if pr = None then 1 + (if x > mi then 1 else 1)
else 4 + T⇩m⇩a⇩x⇩t (treeList ! the pr) ))
else 1)))"
theorem pred_bound_height: "invar_vebt t n ⟹ T⇩p⇩r⇩e⇩d t x ≤ (1+height t)*29"
proof(induction t n arbitrary: x rule: invar_vebt.induct)
case (1 a b)
then show ?case apply(cases x)
using T⇩p⇩r⇩e⇩d.simps(1)[of a b] apply simp
apply(cases "x > 1")
using T⇩p⇩r⇩e⇩d.simps(3)[of a b]
apply (smt (z3) One_nat_def Suc_eq_numeral height.simps(1) less_Suc_eq_le less_antisym less_imp_Suc_add mult.left_neutral not_less numeral_One numeral_eq_iff numeral_le_one_iff plus_1_eq_Suc pred_numeral_simps(3) semiring_norm(70) semiring_norm(85))
using T⇩p⇩r⇩e⇩d.simps(2)[of a b] apply simp
done
next
case (2 treeList n summary m deg)
then show ?case by simp
next
case (3 treeList n summary m deg)
then show ?case by simp
next
case (4 treeList n summary m deg mi ma)
hence "deg ≥ 2"
by (metis add_self_div_2 deg_not_0 div_greater_zero_iff)
then show ?case
proof(cases "x > ma")
case True
hence " T⇩p⇩r⇩e⇩d (Node (Some (mi, ma)) deg treeList summary) x =2" using T⇩p⇩r⇩e⇩d.simps(7)[of mi ma "deg-2" treeList summary x ]
by (smt (z3) Suc_1 ‹2 ≤ deg› add_2_eq_Suc le_add_diff_inverse plus_1_eq_Suc)
then show ?thesis by simp
next
case False
let ?l = "low x (deg div 2)"
let ?h = "high x (deg div 2)"
have 0: "T⇩p⇩r⇩e⇩d (Node (Some (mi, ma)) deg treeList summary) x = 1 + 10 +1 +
(if ?h < length treeList then
let minlow = vebt_mint (treeList ! ?h) in 2 + T⇩m⇩i⇩n⇩t(treeList ! ?h) + 3 +
(if minlow ≠ None ∧ (Some ?l >⇩o minlow) then
4 + T⇩p⇩r⇩e⇩d (treeList ! ?h) ?l
else let pr = vebt_pred summary ?h in 1 + T⇩p⇩r⇩e⇩d summary ?h+ 1 + (
if pr = None then 1 + (if x > mi then 1 else 1)
else 4 + T⇩m⇩a⇩x⇩t (treeList ! the pr) ))
else 1)"
using T⇩p⇩r⇩e⇩d.simps(7)[of mi ma "deg-2" treeList summary x] False ‹2 ≤ deg›
by (smt (z3) Suc_1 Suc_eq_plus1 add.assoc add.commute le_add_diff_inverse)
then show ?thesis
proof(cases " ?h < length treeList")
case True
let ?minlow = "vebt_mint (treeList ! ?h)"
have 1: "T⇩p⇩r⇩e⇩d (Node (Some (mi, ma)) deg treeList summary) x =17 + T⇩m⇩i⇩n⇩t(treeList ! ?h) +
(if ?minlow ≠ None ∧ (Some ?l >⇩o ?minlow) then
4 + T⇩p⇩r⇩e⇩d (treeList ! ?h) ?l
else let pr = vebt_pred summary ?h in 1 + T⇩p⇩r⇩e⇩d summary ?h+ 1 + (
if pr = None then 1 + (if x > mi then 1 else 1)
else 4 + T⇩m⇩a⇩x⇩t (treeList ! the pr) ))" using True 0 by simp
then show ?thesis
proof(cases "?minlow ≠ None ∧ (Some ?l >⇩o ?minlow)")
case True
have 2: "T⇩p⇩r⇩e⇩d (Node (Some (mi, ma)) deg treeList summary) x =21 + T⇩m⇩i⇩n⇩t(treeList ! ?h) +
T⇩p⇩r⇩e⇩d (treeList ! ?h) ?l" using True 1 by simp
hence "T⇩p⇩r⇩e⇩d (Node (Some (mi, ma)) deg treeList summary) x ≤ 24 + T⇩p⇩r⇩e⇩d (treeList ! ?h) ?l" using mint_bound by simp
moreover hence "(treeList ! ?h) ∈ set treeList"
using "4.hyps"(2) "4.hyps"(3) "4.hyps"(4) "4.hyps"(8) False high_bound_aux by force
ultimately have "T⇩p⇩r⇩e⇩d (Node (Some (mi, ma)) deg treeList summary) x ≤ 24 + (1 + height(treeList ! ?h))*29"
using "4.IH" by (meson nat_add_left_cancel_le order_trans)
hence "T⇩p⇩r⇩e⇩d (Node (Some (mi, ma)) deg treeList summary) x ≤
24 + (height (Node (Some (mi, ma)) deg treeList summary))*29"
using height_compose_child[of "treeList ! ?h" treeList "Some(mi, ma)" deg summary]
by (meson ‹treeList ! high x (deg div 2) ∈ set treeList› add_le_cancel_left le_refl mult_le_mono order_trans)
then show ?thesis by simp
next
case False
let ?pr = "vebt_pred summary ?h "
have 2: "T⇩p⇩r⇩e⇩d (Node (Some (mi, ma)) deg treeList summary) x =19 + T⇩m⇩i⇩n⇩t(treeList ! ?h) +
T⇩p⇩r⇩e⇩d summary ?h+ (
if ?pr = None then 1 + (if x > mi then 1 else 1)
else 4 + T⇩m⇩a⇩x⇩t (treeList ! the ?pr))" using False 1 by auto
hence 3:"T⇩p⇩r⇩e⇩d (Node (Some (mi, ma)) deg treeList summary) x ≤22 +
T⇩p⇩r⇩e⇩d summary ?h+ (
if ?pr = None then 1 + (if x > mi then 1 else 1)
else 4 + T⇩m⇩a⇩x⇩t (treeList ! the ?pr))" using mint_bound[of "treeList ! ?h"] by simp
then show ?thesis
proof(cases " ?pr = None")
case True
hence "T⇩p⇩r⇩e⇩d (Node (Some (mi, ma)) deg treeList summary) x ≤24 + T⇩p⇩r⇩e⇩d summary ?h" using 3 by simp
hence "T⇩p⇩r⇩e⇩d (Node (Some (mi, ma)) deg treeList summary) x ≤24 + (1+ height summary) * 29"
by (meson "4.IH"(2) add_le_mono dual_order.trans le_refl)
hence "T⇩p⇩r⇩e⇩d (Node (Some (mi, ma)) deg treeList summary) x ≤
24 + (height (Node (Some (mi, ma)) deg treeList summary) ) * 29"
using height_compose_summary[of summary "Some (mi, ma)" deg treeList] by presburger
then show ?thesis by simp
next
case False
hence "T⇩p⇩r⇩e⇩d (Node (Some (mi, ma)) deg treeList summary) x ≤29 +
T⇩p⇩r⇩e⇩d summary ?h " using maxt_bound[of "treeList ! the ?pr"] 3 by auto
hence "T⇩p⇩r⇩e⇩d (Node (Some (mi, ma)) deg treeList summary) x ≤29 + (1+ height summary) * 29"
using "4.IH"(2)[of ?h] by simp
hence "T⇩p⇩r⇩e⇩d (Node (Some (mi, ma)) deg treeList summary) x ≤
29 + (height (Node (Some (mi, ma)) deg treeList summary)) * 29"
using height_compose_summary[of summary "Some (mi, ma)" deg treeList] by presburger
then show ?thesis by simp
qed
qed
next
case False
then show ?thesis using 0 by simp
qed
qed
next
case (5 treeList n summary m deg mi ma)
hence "deg ≥ 2"
by (metis Suc_1 add_mono_thms_linordered_semiring(1) le_add1 plus_1_eq_Suc set_n_deg_not_0)
then show ?case
proof(cases "x > ma")
case True
hence " T⇩p⇩r⇩e⇩d (Node (Some (mi, ma)) deg treeList summary) x =2" using T⇩p⇩r⇩e⇩d.simps(7)[of mi ma "deg-2" treeList summary x ]
by (smt (z3) Suc_1 ‹2 ≤ deg› add_2_eq_Suc le_add_diff_inverse plus_1_eq_Suc)
then show ?thesis by simp
next
case False
let ?l = "low x (deg div 2)"
let ?h = "high x (deg div 2)"
have 0: "T⇩p⇩r⇩e⇩d (Node (Some (mi, ma)) deg treeList summary) x = 1 + 10 +1 +
(if ?h < length treeList then
let minlow = vebt_mint (treeList ! ?h) in 2 + T⇩m⇩i⇩n⇩t(treeList ! ?h) + 3 +
(if minlow ≠ None ∧ (Some ?l >⇩o minlow) then
4 + T⇩p⇩r⇩e⇩d (treeList ! ?h) ?l
else let pr = vebt_pred summary ?h in 1 + T⇩p⇩r⇩e⇩d summary ?h+ 1 + (
if pr = None then 1 + (if x > mi then 1 else 1)
else 4 + T⇩m⇩a⇩x⇩t (treeList ! the pr) ))
else 1)"
using T⇩p⇩r⇩e⇩d.simps(7)[of mi ma "deg-2" treeList summary x] False ‹2 ≤ deg›
by (smt (z3) Suc_1 Suc_eq_plus1 add.assoc add.commute le_add_diff_inverse)
then show ?thesis
proof(cases " ?h < length treeList")
case True
hence " ?h < length treeList" by simp
let ?minlow = "vebt_mint (treeList ! ?h)"
have 1: "T⇩p⇩r⇩e⇩d (Node (Some (mi, ma)) deg treeList summary) x =17 + T⇩m⇩i⇩n⇩t(treeList ! ?h) +
(if ?minlow ≠ None ∧ (Some ?l >⇩o ?minlow) then
4 + T⇩p⇩r⇩e⇩d (treeList ! ?h) ?l
else let pr = vebt_pred summary ?h in 1 + T⇩p⇩r⇩e⇩d summary ?h+ 1 + (
if pr = None then 1 + (if x > mi then 1 else 1)
else 4 + T⇩m⇩a⇩x⇩t (treeList ! the pr) ))"
using True 0 by simp
then show ?thesis
proof(cases "?minlow ≠ None ∧ (Some ?l >⇩o ?minlow)")
case True
have 2: "T⇩p⇩r⇩e⇩d (Node (Some (mi, ma)) deg treeList summary) x =21 + T⇩m⇩i⇩n⇩t(treeList ! ?h) +
T⇩p⇩r⇩e⇩d (treeList ! ?h) ?l" using True 1 by simp
hence "T⇩p⇩r⇩e⇩d (Node (Some (mi, ma)) deg treeList summary) x ≤ 24 + T⇩p⇩r⇩e⇩d (treeList ! ?h) ?l" using mint_bound by simp
moreover hence "(treeList ! ?h) ∈ set treeList"
by (meson ‹high x (deg div 2) < length treeList› nth_mem)
ultimately have "T⇩p⇩r⇩e⇩d (Node (Some (mi, ma)) deg treeList summary) x ≤ 24 + (1 + height(treeList ! ?h))*29"
using "5.IH" by (meson nat_add_left_cancel_le order_trans)
hence "T⇩p⇩r⇩e⇩d (Node (Some (mi, ma)) deg treeList summary) x ≤
24 + (height (Node (Some (mi, ma)) deg treeList summary))*29"
using height_compose_child[of "treeList ! ?h" treeList "Some(mi, ma)" deg summary]
by (meson ‹treeList ! high x (deg div 2) ∈ set treeList› add_le_cancel_left le_refl mult_le_mono order_trans)
then show ?thesis by simp
next
case False
let ?pr = "vebt_pred summary ?h "
have 2: "T⇩p⇩r⇩e⇩d (Node (Some (mi, ma)) deg treeList summary) x =19 + T⇩m⇩i⇩n⇩t(treeList ! ?h) +
T⇩p⇩r⇩e⇩d summary ?h+ (
if ?pr = None then 1 + (if x > mi then 1 else 1)
else 4 + T⇩m⇩a⇩x⇩t (treeList ! the ?pr))"
using False 1 by auto
hence 3:"T⇩p⇩r⇩e⇩d (Node (Some (mi, ma)) deg treeList summary) x ≤22 +
T⇩p⇩r⇩e⇩d summary ?h+ (
if ?pr = None then 1 + (if x > mi then 1 else 1)
else 4 + T⇩m⇩a⇩x⇩t (treeList ! the ?pr))" using mint_bound[of "treeList ! ?h"] by simp
then show ?thesis
proof(cases " ?pr = None")
case True
hence "T⇩p⇩r⇩e⇩d (Node (Some (mi, ma)) deg treeList summary) x ≤24 + T⇩p⇩r⇩e⇩d summary ?h" using 3 by simp
hence "T⇩p⇩r⇩e⇩d (Node (Some (mi, ma)) deg treeList summary) x ≤24 + (1+ height summary) * 29"
by (meson "5.IH"(2) add_le_mono dual_order.trans le_refl)
hence "T⇩p⇩r⇩e⇩d (Node (Some (mi, ma)) deg treeList summary) x ≤
24 + (height (Node (Some (mi, ma)) deg treeList summary) ) * 29"
using height_compose_summary[of summary "Some (mi, ma)" deg treeList] by presburger
then show ?thesis by simp
next
case False
hence "T⇩p⇩r⇩e⇩d (Node (Some (mi, ma)) deg treeList summary) x ≤29 + T⇩p⇩r⇩e⇩d summary ?h "
using maxt_bound[of "treeList ! the ?pr"] 3 by auto
hence "T⇩p⇩r⇩e⇩d (Node (Some (mi, ma)) deg treeList summary) x ≤29 + (1+ height summary) * 29"
using "5.IH"(2)[of ?h] by simp
hence "T⇩p⇩r⇩e⇩d (Node (Some (mi, ma)) deg treeList summary) x ≤
29 + (height (Node (Some (mi, ma)) deg treeList summary)) * 29"
using height_compose_summary[of summary "Some (mi, ma)" deg treeList] by presburger
then show ?thesis by simp
qed
qed
next
case False
then show ?thesis using 0 by simp
qed
qed
qed
theorem pred_bound_size_univ: "invar_vebt t n ⟹ u = 2^n ⟹ T⇩p⇩r⇩e⇩d t x ≤ 58 + 29 * lb (lb u)"
using pred_bound_height[of t n x] height_double_log_univ_size[of u n t] by simp
fun T⇩p⇩r⇩e⇩d'::"VEBT ⇒ nat ⇒ nat " where
"T⇩p⇩r⇩e⇩d' (Leaf _ _) 0 = 1"|
"T⇩p⇩r⇩e⇩d' (Leaf a _) (Suc 0) = 1"|
"T⇩p⇩r⇩e⇩d' (Leaf a b) _ = 1"|
"T⇩p⇩r⇩e⇩d' (Node None _ _ _) _ = 1"|
"T⇩p⇩r⇩e⇩d' (Node _ 0 _ _) _ = 1"|
"T⇩p⇩r⇩e⇩d' (Node _ (Suc 0) _ _) _ = 1"|
"T⇩p⇩r⇩e⇩d' (Node (Some (mi, ma)) deg treeList summary) x = (
if x > ma then 1
else (let l = low x (deg div 2); h = high x (deg div 2) in
(if h < length treeList then
let minlow = vebt_mint (treeList ! h) in
(if minlow ≠ None ∧ (Some l >⇩o minlow) then
1+ T⇩p⇩r⇩e⇩d' (treeList ! h) l
else let pr = vebt_pred summary h in T⇩p⇩r⇩e⇩d' summary h+ (
if pr = None then 1
else 1 ))
else 1)))"
theorem pred_bound_height': "invar_vebt t n⟹ T⇩p⇩r⇩e⇩d' t x ≤ (1 + height t)"
proof(induction t n arbitrary: x rule: invar_vebt.induct)
case (1 a b)
then show ?case
by (metis One_nat_def Suc_eq_plus1_left T⇩p⇩r⇩e⇩d'.simps(1) T⇩p⇩r⇩e⇩d'.simps(2) T⇩p⇩r⇩e⇩d'.simps(3) vebt_buildup.cases height.simps(1) le_refl)
next
case (4 treeList n summary m deg mi ma)
hence degprop:"deg ≥ 2"
by (metis add_self_div_2 deg_not_0 div_greater_zero_iff)
then show ?case
proof(cases "x > ma")
case True
then show ?thesis using T⇩p⇩r⇩e⇩d'.simps(7)[of mi ma "deg -2" treeList summary x ] degprop
by (metis add_2_eq_Suc le_add_diff_inverse le_numeral_extra(4) trans_le_add1)
next
case False
hence "x ≤ ma" by simp
let ?l = "low x (deg div 2)"
let ?h = "high x (deg div 2)"
show ?thesis
proof(cases "?h< length treeList")
case True
hence hprop: "?h< length treeList" by simp
let ?minlow = "vebt_mint (treeList ! ?h)"
show ?thesis
proof(cases "?minlow ≠ None ∧ (Some ?l >⇩o ?minlow)")
case True
hence "T⇩p⇩r⇩e⇩d' (Node (Some (mi, ma)) deg treeList summary) x = 1+ T⇩p⇩r⇩e⇩d' (treeList ! ?h) ?l"
using T⇩p⇩r⇩e⇩d'.simps(7)[of mi ma "deg -2" treeList summary x ] degprop hprop
by (smt (z3) False add_2_eq_Suc le_add_diff_inverse)
moreover have "treeList ! ?h ∈ set treeList" using hprop by simp
moreover hence "T⇩p⇩r⇩e⇩d' (treeList ! ?h) ?l ≤ 1 + height (treeList ! ?h)" using 4(1) by simp
ultimately have "T⇩p⇩r⇩e⇩d' (Node (Some (mi, ma)) deg treeList summary) x ≤ 1+ 1+ height (treeList ! ?h)" by simp
then show ?thesis
by (smt (z3) Suc_le_mono ‹T⇩p⇩r⇩e⇩d' (Node (Some (mi, ma)) deg treeList summary) x = 1 + T⇩p⇩r⇩e⇩d' (treeList ! high x (deg div 2)) (low x (deg div 2))› ‹T⇩p⇩r⇩e⇩d' (treeList ! high x (deg div 2)) (low x (deg div 2)) ≤ 1 + height (treeList ! high x (deg div 2))› ‹treeList ! high x (deg div 2) ∈ set treeList› height_compose_child le_trans plus_1_eq_Suc)
next
case False
hence "T⇩p⇩r⇩e⇩d' (Node (Some (mi, ma)) deg treeList summary) x = 1+ T⇩p⇩r⇩e⇩d' summary ?h"
using T⇩p⇩r⇩e⇩d'.simps(7)[of mi ma "deg -2" treeList summary x ] degprop hprop
by (cases "vebt_pred summary ?h")
(smt (z3) Suc_eq_plus1 ‹x ≤ ma› add_2_eq_Suc le_add_diff_inverse linorder_not_less plus_1_eq_Suc)+
hence "T⇩p⇩r⇩e⇩d' (Node (Some (mi, ma)) deg treeList summary) x ≤ 1 + 1 +height summary" using 4(2)[of ?h] by simp
then show ?thesis by(simp add: le_trans)
qed
next
case False
then show ?thesis using T⇩p⇩r⇩e⇩d'.simps(7)[of mi ma "deg -2" treeList summary x ] degprop
by (metis "4.hyps"(2) "4.hyps"(3) "4.hyps"(4) "4.hyps"(8) ‹x ≤ ma› add_self_div_2 high_bound_aux le_less_trans)
qed
qed
next
case (5 treeList n summary m deg mi ma)
hence degprop:"deg ≥ 2"
by (metis Suc_1 leD less_numeral_extra(1) not_add_less1 not_less_eq_eq not_less_iff_gr_or_eq plus_1_eq_Suc set_n_deg_not_0)
then show ?case
proof(cases "x > ma")
case True
then show ?thesis using T⇩p⇩r⇩e⇩d'.simps(7)[of mi ma "deg -2" treeList summary x ] degprop
by (metis add_2_eq_Suc le_add_diff_inverse le_numeral_extra(4) trans_le_add1)
next
case False
hence "x ≤ ma" by simp
let ?l = "low x (deg div 2)"
let ?h = "high x (deg div 2)"
show ?thesis
proof(cases "?h< length treeList")
case True
hence hprop: "?h< length treeList" by simp
let ?minlow = "vebt_mint (treeList ! ?h)"
show ?thesis
proof(cases "?minlow ≠ None ∧ (Some ?l >⇩o ?minlow)")
case True
hence "T⇩p⇩r⇩e⇩d' (Node (Some (mi, ma)) deg treeList summary) x = 1+ T⇩p⇩r⇩e⇩d' (treeList ! ?h) ?l"
using T⇩p⇩r⇩e⇩d'.simps(7)[of mi ma "deg -2" treeList summary x ] degprop hprop
by (smt (z3) False add_2_eq_Suc le_add_diff_inverse)
moreover have "treeList ! ?h ∈ set treeList" using hprop by simp
moreover hence "T⇩p⇩r⇩e⇩d' (treeList ! ?h) ?l ≤ 1 + height (treeList ! ?h)" using 5(1) by simp
ultimately have "T⇩p⇩r⇩e⇩d' (Node (Some (mi, ma)) deg treeList summary) x ≤ 1+ 1+ height (treeList ! ?h)" by simp
then show ?thesis
by (smt (z3) Suc_le_mono ‹T⇩p⇩r⇩e⇩d' (Node (Some (mi, ma)) deg treeList summary) x = 1 + T⇩p⇩r⇩e⇩d' (treeList ! high x (deg div 2)) (low x (deg div 2))› ‹T⇩p⇩r⇩e⇩d' (treeList ! high x (deg div 2)) (low x (deg div 2)) ≤ 1 + height (treeList ! high x (deg div 2))› ‹treeList ! high x (deg div 2) ∈ set treeList› height_compose_child le_trans plus_1_eq_Suc)
next
case False
hence "T⇩p⇩r⇩e⇩d' (Node (Some (mi, ma)) deg treeList summary) x = 1+ T⇩p⇩r⇩e⇩d' summary ?h"
using T⇩p⇩r⇩e⇩d'.simps(7)[of mi ma "deg -2" treeList summary x ] degprop hprop
by (cases "vebt_pred summary ?h")
(smt (z3) Suc_eq_plus1 ‹x ≤ ma› add_2_eq_Suc le_add_diff_inverse linorder_not_less plus_1_eq_Suc)+
hence "T⇩p⇩r⇩e⇩d' (Node (Some (mi, ma)) deg treeList summary) x ≤ 1 + 1 +height summary" using 5(2)[of ?h] by simp
then show ?thesis by(simp add: le_trans)
qed
next
case False
then show ?thesis using T⇩p⇩r⇩e⇩d'.simps(7)[of mi ma "deg -2" treeList summary x ] degprop
by (smt (z3) add_2_eq_Suc leI le_add_diff_inverse not_add_less1)
qed
qed
qed simp+
theorem pred_bound_size_univ': "invar_vebt t n ⟹ u = 2^n ⟹ T⇩p⇩r⇩e⇩d' t x ≤ 2 + lb (lb u)"
using pred_bound_height'[of t n x] height_double_log_univ_size[of u n t] by simp
end
end
Theory VEBT_DeleteBounds
theory VEBT_DeleteBounds imports VEBT_Bounds VEBT_Delete VEBT_DeleteCorrectness
begin
subsection ‹Running Time Bounds for Deletion›
context begin
interpretation VEBT_internal .
fun T⇩d⇩e⇩l⇩e⇩t⇩e::"VEBT ⇒ nat ⇒ nat" where
"T⇩d⇩e⇩l⇩e⇩t⇩e (Leaf a b) 0 = 1"|
"T⇩d⇩e⇩l⇩e⇩t⇩e (Leaf a b) (Suc 0) = 1"|
"T⇩d⇩e⇩l⇩e⇩t⇩e (Leaf a b) (Suc (Suc n)) = 1"|
"T⇩d⇩e⇩l⇩e⇩t⇩e (Node None deg treeList summary) _ = 1"|
"T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) 0 treeList summary) x = 1"|
"T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) (Suc 0) treeList summary) x =1 "|
"T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x = 3 + (
if (x < mi ∨ x > ma) then 1
else 3 + (if (x = mi ∧ x = ma) then 3
else 13 + ( if x = mi then T⇩m⇩i⇩n⇩t summary + T⇩m⇩i⇩n⇩t (treeList ! the (vebt_mint summary))+ 7 else 1 )+
(if x = mi then 1 else 1) +
( let xn = (if x = mi
then the (vebt_mint summary) * 2^(deg div 2) + the (vebt_mint (treeList ! the (vebt_mint summary)))
else x);
minn = (if x = mi then xn else mi);
l = low xn (deg div 2);
h = high xn (deg div 2) in
if h < length treeList
then( 4 + T⇩d⇩e⇩l⇩e⇩t⇩e (treeList ! h) l +(
let newnode = vebt_delete (treeList ! h) l;
newlist = treeList[h:= newnode]in 1 + T⇩m⇩i⇩n⇩N⇩u⇩l⇩l newnode + (
if minNull newnode
then( 1 + T⇩d⇩e⇩l⇩e⇩t⇩e summary h + (
let sn = vebt_delete summary h in
2+ (if xn = ma then 1 + T⇩m⇩a⇩x⇩t sn + (let maxs = vebt_maxt sn in
1 + (if maxs = None
then 1
else 8+ T⇩m⇩a⇩x⇩t (newlist ! the maxs)
) )
else 1)
))else
2 + (if xn = ma then 6+ T⇩m⇩a⇩x⇩t (newlist ! h) else 1)
)))else 1 )))"
end
context VEBT_internal begin
lemma tdeletemimi:"deg ≥ 2 ⟹ T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, mi)) deg treeList summary) x ≤ 9"
using T⇩d⇩e⇩l⇩e⇩t⇩e.simps(7)[of mi mi "deg-2" treeList summary x]
apply(cases "x ≠ mi")
apply (smt (z3) One_nat_def Suc_1 add_Suc_shift div_le_dividend le_add_diff_inverse not_less_iff_gr_or_eq numeral_3_eq_3 numeral_Bit0 numeral_Bit1_div_2 plus_1_eq_Suc)
apply (smt (z3) Suc3_eq_add_3 Suc_eq_plus1 Suc_nat_number_of_add add_2_eq_Suc dual_order.eq_iff le_add_diff_inverse nat_less_le numeral_Bit1 semiring_norm(2) semiring_norm(8))
done
lemma minNull_delete_time_bound: "invar_vebt t n ⟹ minNull (vebt_delete t x) ⟹ T⇩d⇩e⇩l⇩e⇩t⇩e t x ≤ 9"
proof(induction t n rule: invar_vebt.induct)
case (1 a b)
then show ?case
apply(cases x)
apply simp
apply(cases "x=1")
apply simp
by (smt (z3) One_nat_def Suc_diff_le Suc_leI T⇩d⇩e⇩l⇩e⇩t⇩e.simps(3) diff_Suc_Suc le_add_diff_inverse one_le_numeral order.not_eq_order_implies_strict plus_1_eq_Suc zero_less_Suc)
next
case (2 treeList n summary m deg)
then show ?case by simp
next
case (3 treeList n summary m deg)
then show ?case by simp
next
case (4 treeList n summary m deg mi ma)
hence "deg ≥ 2"
by (metis add_self_div_2 deg_not_0 div_greater_zero_iff)
then show ?case
proof(cases "(x < mi ∨ x > ma)")
case True
then show ?thesis
using "4.prems" ‹2 ≤ deg› delt_out_of_range by force
next
case False
hence "x ≤ ma ∧ x ≥ mi" by simp
then show ?thesis
proof(cases "(x = mi ∧ x = ma)")
case True
then show ?thesis
using ‹2 ≤ deg› tdeletemimi by blast
next
case False
hence "¬ (x = mi ∧ x = ma)" by simp
then show ?thesis
proof(cases "x = mi")
case True
hence "x = mi" by simp
let ?xn = "the (vebt_mint summary) * 2^(deg div 2)
+ the (vebt_mint (treeList ! the (vebt_mint summary)))"
let ?l = "low ?xn (deg div 2)"
let ?h = "high ?xn (deg div 2)"
have "∃ y. both_member_options summary y"
using "4.hyps"(4) "4.hyps"(5) "4.hyps"(8) "4.hyps"(9) False True high_bound_aux by blast
then obtain i where aa:" (vebt_mint summary) = Some i"
by (metis "4.hyps"(1) Collect_empty_eq mint_corr_help_empty not_Some_eq set_vebt'_def valid_member_both_member_options)
hence "∃ y. both_member_options (treeList ! i ) y"
by (meson "4.hyps"(1) "4.hyps"(5) both_member_options_equiv_member member_bound mint_member)
hence "∃ y. both_member_options (treeList ! the (vebt_mint summary) ) y"
using ‹vebt_mint summary = Some i› by auto
hence "invar_vebt (treeList ! the (vebt_mint summary)) n"
by (metis "4.IH"(1) "4.hyps"(1) "4.hyps"(2) ‹vebt_mint summary = Some i› option.sel member_bound mint_member nth_mem)
then obtain y where "(vebt_mint (treeList ! the (vebt_mint summary))) = Some y"
by (metis Collect_empty_eq ‹∃y. both_member_options (treeList ! the (vebt_mint summary)) y› mint_corr_help_empty option.exhaust set_vebt'_def valid_member_both_member_options)
have "y < 2^n ∧ i < 2^m"
using "4.hyps"(1) ‹vebt_mint (treeList ! the (vebt_mint summary)) = Some y› ‹invar_vebt (treeList ! the (vebt_mint summary)) n› aa member_bound mint_member by blast
hence "?h ≤ 2^m" using aa
using "4.hyps"(3) "4.hyps"(4) ‹vebt_mint (treeList ! the (vebt_mint summary)) = Some y› high_inv by force
have 0:"vebt_delete (Node (Some (mi, ma)) deg treeList summary) x =(
let newnode = vebt_delete (treeList ! ?h) ?l;
newlist = treeList[?h:= newnode]in
if minNull newnode
then(
let sn = vebt_delete summary ?h in
(Node (Some (?xn, if ?xn = ma then (let maxs = vebt_maxt sn in
(if maxs = None
then ?xn
else 2^(deg div 2) * the maxs
+ the (vebt_maxt (newlist ! the maxs))
)
)
else ma))
deg newlist sn)
)else
(Node (Some (?xn, (if ?xn = ma then
?h * 2^(deg div 2) + the( vebt_maxt (newlist ! ?h))
else ma)))
deg newlist summary ))"
using del_x_mi[of x mi ma deg ?xn ?h summary treeList ?l] "4.hyps"(2) "4.hyps"(3)
"4.hyps"(4) "4.hyps"(7) False True ‹2 ≤ deg› ‹vebt_mint (treeList ! the (vebt_mint summary)) =
Some y› ‹y < 2 ^ n ∧ i < 2 ^ m› aa high_inv
by fastforce
let ?newnode = "vebt_delete (treeList ! ?h) ?l"
let ?newlist = "treeList[?h:= ?newnode]"
show ?thesis
proof(cases "minNull ?newnode")
case True
then show ?thesis
by (smt (z3) "0" "4.prems" minNull.simps(5))
next
case False
then show ?thesis
by (smt (z3) "0" "4.prems" minNull.simps(5))
qed
next
case False
hence "x > mi"
using ‹x ≤ ma ∧ mi ≤ x› nat_less_le by blast
let ?l = "low x (deg div 2)"
let ?h = "high x (deg div 2)"
let ?newnode = "vebt_delete (treeList ! ?h) ?l"
let ?newlist = "treeList[?h:= ?newnode]"
have "?h < length treeList"
using "4.hyps"(2) "4.hyps"(3) "4.hyps"(4) "4.hyps"(8) ‹x ≤ ma ∧ mi ≤ x› high_bound_aux by auto
hence 0:"vebt_delete (Node (Some (mi, ma)) deg treeList summary) x = (
if minNull ?newnode
then(
let sn = vebt_delete summary ?h in
(Node (Some (mi, if x = ma then (let maxs = vebt_maxt sn in
(if maxs = None
then mi
else 2^(deg div 2) * the maxs
+ the (vebt_maxt (?newlist ! the maxs))
)
)
else ma))
deg ?newlist sn)
)else
(Node (Some (mi, (if x = ma then
?h * 2^(deg div 2) + the( vebt_maxt (?newlist ! ?h))
else ma)))
deg ?newlist summary ))"
using del_x_not_mi[of mi x ma deg ?h ?l ?newnode ?newlist treeList summary]
by (metis ‹2 ≤ deg› ‹mi < x› ‹x ≤ ma ∧ mi ≤ x› del_x_not_mi leD)
then show ?thesis
proof(cases " minNull ?newnode ")
case True
then show ?thesis
by (metis "0" "4.prems" minNull.simps(5))
next
case False
then show ?thesis
using "0" "4.prems" by fastforce
qed
qed
qed
qed
next
case (5 treeList n summary m deg mi ma)
hence "deg ≥ 2"
by (metis Suc_1 add_mono_thms_linordered_semiring(1) le_add1 plus_1_eq_Suc set_n_deg_not_0)
then show ?case
proof(cases "(x < mi ∨ x > ma)")
case True
then show ?thesis
using "5.prems" ‹2 ≤ deg› delt_out_of_range by force
next
case False
hence "x ≤ ma ∧ x ≥ mi" by simp
then show ?thesis
proof(cases "(x = mi ∧ x = ma)")
case True
then show ?thesis
using ‹2 ≤ deg› tdeletemimi by blast
next
case False
hence "¬ (x = mi ∧ x = ma)" by simp
then show ?thesis
proof(cases "x = mi")
case True
hence "x = mi" by simp
let ?xn = "the (vebt_mint summary) * 2^(deg div 2)
+ the (vebt_mint (treeList ! the (vebt_mint summary)))"
let ?l = "low ?xn (deg div 2)"
let ?h = "high ?xn (deg div 2)"
have "∃ y. both_member_options summary y"
using "5.hyps"(4) "5.hyps"(5) "5.hyps"(8) "5.hyps"(9) False True high_bound_aux by blast
then obtain i where aa:" (vebt_mint summary) = Some i"
by (metis "5.hyps"(1) Collect_empty_eq mint_corr_help_empty not_Some_eq set_vebt'_def valid_member_both_member_options)
hence "∃ y. both_member_options (treeList ! i ) y"
by (meson "5.hyps"(1) "5.hyps"(5) both_member_options_equiv_member member_bound mint_member)
hence "∃ y. both_member_options (treeList ! the (vebt_mint summary) ) y"
using ‹vebt_mint summary = Some i› by auto
hence "invar_vebt (treeList ! the (vebt_mint summary)) n"
by (metis "5.IH"(1) "5.hyps"(1) "5.hyps"(2) ‹vebt_mint summary = Some i› option.sel member_bound mint_member nth_mem)
then obtain y where "(vebt_mint (treeList ! the (vebt_mint summary))) = Some y"
by (metis Collect_empty_eq ‹∃y. both_member_options (treeList ! the (vebt_mint summary)) y› mint_corr_help_empty option.exhaust set_vebt'_def valid_member_both_member_options)
have "y < 2^n ∧ i < 2^m"
using "5.hyps"(1) ‹vebt_mint (treeList ! the (vebt_mint summary)) = Some y› ‹invar_vebt (treeList ! the (vebt_mint summary)) n› aa member_bound mint_member by blast
hence "?h ≤ 2^m" using aa
using "5.hyps"(3) "5.hyps"(4) ‹vebt_mint (treeList ! the (vebt_mint summary)) = Some y› high_inv by force
have 0:"vebt_delete (Node (Some (mi, ma)) deg treeList summary) x =(
let newnode = vebt_delete (treeList ! ?h) ?l;
newlist = treeList[?h:= newnode]in
if minNull newnode
then(
let sn = vebt_delete summary ?h in
(Node (Some (?xn, if ?xn = ma then (let maxs = vebt_maxt sn in
(if maxs = None
then ?xn
else 2^(deg div 2) * the maxs
+ the (vebt_maxt (newlist ! the maxs))
)
)
else ma))
deg newlist sn)
)else
(Node (Some (?xn, (if ?xn = ma then
?h * 2^(deg div 2) + the( vebt_maxt (newlist ! ?h))
else ma)))
deg newlist summary )) "
using del_x_mi[of x mi ma deg ?xn ?h summary treeList ?l] "5.hyps"(2) "5.hyps"(3)
"5.hyps"(4) "5.hyps"(7) False True ‹2 ≤ deg› ‹vebt_mint (treeList ! the (vebt_mint summary
)) = Some y› ‹y < 2 ^ n ∧ i < 2 ^ m› aa high_inv
by fastforce
let ?newnode = "vebt_delete (treeList ! ?h) ?l"
let ?newlist = "treeList[?h:= ?newnode]"
show ?thesis
proof(cases "minNull ?newnode")
case True
then show ?thesis
by (smt (z3) "0" "5.prems" minNull.simps(5))
next
case False
then show ?thesis
by (smt (z3) "0" "5.prems" minNull.simps(5))
qed
next
case False
hence "x > mi"
using ‹x ≤ ma ∧ mi ≤ x› nat_less_le by blast
let ?l = "low x (deg div 2)"
let ?h = "high x (deg div 2)"
let ?newnode = "vebt_delete (treeList ! ?h) ?l"
let ?newlist = "treeList[?h:= ?newnode]"
have "x <2^deg"
using "5.hyps"(8) ‹x ≤ ma ∧ mi ≤ x› dual_order.strict_trans2 by blast
hence "?h < 2^m" using "5.prems" ‹2 ≤ deg› ‹mi < x› ‹x ≤ ma ∧ mi ≤ x›
del_in_range minNull.simps(5) verit_comp_simplify1(3) apply simp
by (smt (z3) minNull.simps(5))
hence 0:"vebt_delete (Node (Some (mi, ma)) deg treeList summary) x = (
if minNull ?newnode
then(
let sn = vebt_delete summary ?h in
(Node (Some (mi, if x = ma then (let maxs = vebt_maxt sn in
(if maxs = None
then mi
else 2^(deg div 2) * the maxs
+ the (vebt_maxt (?newlist ! the maxs))
)
)
else ma))
deg ?newlist sn)
)else
(Node (Some (mi, (if x = ma then
?h * 2^(deg div 2) + the( vebt_maxt (?newlist ! ?h))
else ma)))
deg ?newlist summary ))" using del_x_not_mi[of mi x ma deg ?h ?l ?newnode ?newlist treeList summary]
by (metis "5.hyps"(2) ‹2 ≤ deg› ‹mi < x› ‹x ≤ ma ∧ mi ≤ x› del_x_not_mi leD)
then show ?thesis
proof(cases " minNull ?newnode ")
case True
then show ?thesis
by (metis "0" "5.prems" minNull.simps(5))
next
case False
then show ?thesis
using "0" "5.prems" by fastforce
qed
qed
qed
qed
qed
lemma delete_bound_height: "invar_vebt t n ⟹ T⇩d⇩e⇩l⇩e⇩t⇩e t x ≤ (1+ height t)*70"
proof(induction t n arbitrary: x rule: invar_vebt.induct)
case (1 a b)
then show ?case
apply(cases x)
apply simp
apply(cases "x = 1")
apply simp
apply (metis One_nat_def Suc_eq_plus1_left Suc_le_mono T⇩d⇩e⇩l⇩e⇩t⇩e.simps(3) comm_monoid_mult_class.mult_1 dual_order.trans height.simps(1) le_SucE lessI less_Suc_eq_le less_imp_Suc_add one_le_numeral zero_less_Suc)
done
next
case (2 treeList n summary m deg)
then show ?case by simp
next
case (3 treeList n summary m deg)
then show ?case by simp
next
case (4 treeList n summary m deg mi ma)
hence deggy: "deg ≥ 2"
by (metis add_self_div_2 deg_not_0 div_greater_zero_iff)
then show ?case
proof(cases " (x < mi ∨ x > ma)")
case True
hence " T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x = 4" using
T⇩d⇩e⇩l⇩e⇩t⇩e.simps(7)[of mi ma "deg-2" treeList summary x]
by (smt (z3) Suc3_eq_add_3 Suc_1 ‹2 ≤ deg› add_2_eq_Suc' le_add_diff_inverse2 numeral_code(2))
then show ?thesis using T⇩d⇩e⇩l⇩e⇩t⇩e.simps(7)[of mi ma "deg-2" treeList summary x] by auto
next
case False
hence "mi ≤ x ∧ x ≤ ma" by simp
hence 0: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x = 3+3 + (if (x = mi ∧ x = ma) then 3
else 13 + ( if x = mi then T⇩m⇩i⇩n⇩t summary + T⇩m⇩i⇩n⇩t (treeList ! the (vebt_mint summary))+ 7 else 1 )+
(if x = mi then 1 else 1) +
( let xn = (if x = mi
then the (vebt_mint summary) * 2^(deg div 2) + the (vebt_mint (treeList ! the (vebt_mint summary)))
else x);
minn = (if x = mi then xn else mi);
l = low xn (deg div 2);
h = high xn (deg div 2) in
if h < length treeList
then( 4 + T⇩d⇩e⇩l⇩e⇩t⇩e (treeList ! h) l +(
let newnode = vebt_delete (treeList ! h) l;
newlist = treeList[h:= newnode]in 1 + T⇩m⇩i⇩n⇩N⇩u⇩l⇩l newnode + (
if minNull newnode
then( 1 + T⇩d⇩e⇩l⇩e⇩t⇩e summary h + (
let sn = vebt_delete summary h in
2+ (if xn = ma then 1 + T⇩m⇩a⇩x⇩t sn + (let maxs = vebt_maxt sn in
1 + (if maxs = None
then 1
else 8+ T⇩m⇩a⇩x⇩t (newlist ! the maxs)
) )
else 1)
))else
2 + (if xn = ma then 6+ T⇩m⇩a⇩x⇩t (newlist ! h) else 1)
)))else 1 ))" using T⇩d⇩e⇩l⇩e⇩t⇩e.simps(7)[of mi ma "deg-2" treeList summary x] deggy
by (smt (z3) False add.commute add_2_eq_Suc' add_numeral_left le_add_diff_inverse numeral_plus_numeral)
then show ?thesis
proof(cases " (x = mi ∧ x = ma)")
case True
hence "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x = 9" using 0 by simp
then show ?thesis by simp
next
case False
hence 1: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x =3+3 +13+
(if x = mi then T⇩m⇩i⇩n⇩t summary + T⇩m⇩i⇩n⇩t (treeList ! the (vebt_mint summary))+ 7 else 1 )+
(if x = mi then 1 else 1) +
(let xn = (if x = mi
then the (vebt_mint summary) * 2^(deg div 2) + the (vebt_mint (treeList ! the (vebt_mint summary)))
else x);
minn = (if x = mi then xn else mi);
l = low xn (deg div 2);
h = high xn (deg div 2) in
if h < length treeList
then( 4 + T⇩d⇩e⇩l⇩e⇩t⇩e (treeList ! h) l +(
let newnode = vebt_delete (treeList ! h) l;
newlist = treeList[h:= newnode]in 1 + T⇩m⇩i⇩n⇩N⇩u⇩l⇩l newnode + (
if minNull newnode
then( 1 + T⇩d⇩e⇩l⇩e⇩t⇩e summary h + (
let sn = vebt_delete summary h in
2+ (if xn = ma then 1 + T⇩m⇩a⇩x⇩t sn + (let maxs = vebt_maxt sn in
1 + (if maxs = None
then 1
else 8+ T⇩m⇩a⇩x⇩t (newlist ! the maxs)
) )
else 1)
))else
2 + (if xn = ma then 6+ T⇩m⇩a⇩x⇩t (newlist ! h) else 1)
)))else 1 )" using 0
by (simp add: False)
then show ?thesis
proof(cases "x = mi")
case True
let ?xn = " the (vebt_mint summary) * 2^(deg div 2) + the (vebt_mint (treeList ! the (vebt_mint summary)))"
have 2: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x =3+3 +13+ T⇩m⇩i⇩n⇩t summary +
T⇩m⇩i⇩n⇩t (treeList ! the (vebt_mint summary))+ 7+1 +
(let l = low ?xn (deg div 2);
h = high ?xn (deg div 2) in
if h < length treeList
then( 4 + T⇩d⇩e⇩l⇩e⇩t⇩e (treeList ! h) l +(
let newnode = vebt_delete (treeList ! h) l;
newlist = treeList[h:= newnode]in 1 + T⇩m⇩i⇩n⇩N⇩u⇩l⇩l newnode + (
if minNull newnode
then( 1 + T⇩d⇩e⇩l⇩e⇩t⇩e summary h + (
let sn = vebt_delete summary h in
2+ (if ?xn = ma then 1 + T⇩m⇩a⇩x⇩t sn + (let maxs = vebt_maxt sn in
1 + (if maxs = None
then 1
else 8+ T⇩m⇩a⇩x⇩t (newlist ! the maxs)
) ) else 1) ))else
2 + (if ?xn = ma then 6+ T⇩m⇩a⇩x⇩t (newlist ! h) else 1)
)))else 1 )"
using 1 by (smt (z3) True add.assoc)
let ?l = "low ?xn (deg div 2)"
let ?h = "high ?xn (deg div 2)"
have 3: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x = 3+3 +13+ T⇩m⇩i⇩n⇩t summary +
T⇩m⇩i⇩n⇩t (treeList ! the (vebt_mint summary))+ 7+1 +
(if ?h < length treeList
then( 4 + T⇩d⇩e⇩l⇩e⇩t⇩e (treeList ! ?h) ?l +(
let newnode = vebt_delete (treeList ! ?h) ?l;
newlist = treeList[?h:= newnode]in 1 + T⇩m⇩i⇩n⇩N⇩u⇩l⇩l newnode + (
if minNull newnode
then( 1 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h + (
let sn = vebt_delete summary ?h in
2+ (if ?xn = ma then 1 + T⇩m⇩a⇩x⇩t sn + (let maxs = vebt_maxt sn in
1 + (if maxs = None
then 1
else 8+ T⇩m⇩a⇩x⇩t (newlist ! the maxs)
) ) else 1) ))else
2 + (if ?xn = ma then 6+ T⇩m⇩a⇩x⇩t (newlist ! ?h) else 1)
)))else 1 )"
using 2 by meson
then show ?thesis
proof(cases "?h < length treeList")
case True
hence "?h < length treeList" by simp
let ?newnode = "vebt_delete (treeList ! ?h) ?l"
let ?newlist = "treeList[?h:= ?newnode]"
have "invar_vebt (treeList ! ?h) n"
using "4.IH"(1) True nth_mem by blast
hence "invar_vebt ?newnode n"
using delete_pres_valid by blast
have 4: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 37 + T⇩d⇩e⇩l⇩e⇩t⇩e (treeList ! ?h) ?l +(
let newnode = vebt_delete (treeList ! ?h) ?l;
newlist = treeList[?h:= newnode]in 1 + T⇩m⇩i⇩n⇩N⇩u⇩l⇩l newnode + (
if minNull newnode
then( 1 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h + (
let sn = vebt_delete summary ?h in
2+ (if ?xn = ma then 1 + T⇩m⇩a⇩x⇩t sn + (let maxs = vebt_maxt sn in
1 + (if maxs = None
then 1
else 8+ T⇩m⇩a⇩x⇩t (newlist ! the maxs)
) ) else 1) ))else
2 + (if ?xn = ma then 6+ T⇩m⇩a⇩x⇩t (newlist ! ?h) else 1)
))"
using 3 mint_bound[of "treeList ! the (vebt_mint summary)"] mint_bound[of "summary"]
by simp
hence 5: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 38 + T⇩d⇩e⇩l⇩e⇩t⇩e (treeList ! ?h) ?l +(
T⇩m⇩i⇩n⇩N⇩u⇩l⇩l ?newnode + (
if minNull ?newnode
then( 1 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h + (
let sn = vebt_delete summary ?h in
2+ (if ?xn = ma then 1 + T⇩m⇩a⇩x⇩t sn + (let maxs = vebt_maxt sn in
1 + (if maxs = None
then 1
else 8+ T⇩m⇩a⇩x⇩t (?newlist ! the maxs)
) ) else 1) ))else
2 + (if ?xn = ma then 6+ T⇩m⇩a⇩x⇩t (?newlist ! ?h) else 1)
))"
by (smt (z3) Suc_eq_plus1 add.commute add_Suc numeral_plus_one semiring_norm(5) semiring_norm(8))
then show ?thesis
proof(cases "minNull ?newnode ")
case True
hence 6: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 39 + T⇩d⇩e⇩l⇩e⇩t⇩e (treeList ! ?h) ?l
+ 1 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h + (
let sn = vebt_delete summary ?h in
2+ (if ?xn = ma then 1 + T⇩m⇩a⇩x⇩t sn + (let maxs = vebt_maxt sn in
1 + (if maxs = None
then 1
else 8+ T⇩m⇩a⇩x⇩t (?newlist ! the maxs)
) ) else 1))" using 5 minNull_bound[of ?newnode] by presburger
have 7: " T⇩d⇩e⇩l⇩e⇩t⇩e (treeList ! ?h) ?l ≤ 9" using True
minNull_delete_time_bound[of "treeList ! ?h"]
using ‹invar_vebt (treeList ! high (the (vebt_mint summary) * 2 ^ (deg div 2) + the (vebt_mint (treeList ! the (vebt_mint summary)))) (deg div 2)) n› by blast
let ?sn = "vebt_delete summary ?h"
have 8: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 39 + T⇩d⇩e⇩l⇩e⇩t⇩e (treeList ! ?h) ?l
+ 1 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h + (
2+ (if ?xn = ma then 1 + T⇩m⇩a⇩x⇩t ?sn + (let maxs = vebt_maxt ?sn in
1 + (if maxs = None
then 1
else 8+ T⇩m⇩a⇩x⇩t (?newlist ! the maxs)
) ) else 1))"
by (meson "6")
hence 9: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 39 + 9 + 1 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h + 2+
(if ?xn = ma then 1 + T⇩m⇩a⇩x⇩t ?sn + (let maxs = vebt_maxt ?sn in
1 + (if maxs = None
then 1
else 8+ T⇩m⇩a⇩x⇩t (?newlist ! the maxs)
) ) else 1)" using 6 7 by force
hence 10: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 51 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h +
(if ?xn = ma then 1 + T⇩m⇩a⇩x⇩t ?sn + (let maxs = vebt_maxt ?sn in
1 + (if maxs = None
then 1
else 8+ T⇩m⇩a⇩x⇩t (?newlist ! the maxs)
) ) else 1)" by simp
then show ?thesis
proof(cases "?xn = ma")
case True
hence 10: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 51 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h +
1 + T⇩m⇩a⇩x⇩t ?sn + (let maxs = vebt_maxt ?sn in
1 + (if maxs = None
then 1
else 8+ T⇩m⇩a⇩x⇩t (?newlist ! the maxs)
))" using 10
by (smt (z3) add.assoc trans_le_add1)
hence 11: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 55 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h +
(let maxs = vebt_maxt ?sn in
1 + (if maxs = None
then 1
else 8+ T⇩m⇩a⇩x⇩t (?newlist ! the maxs)
))" using maxt_bound[of ?sn] by force
then show ?thesis
proof(cases " vebt_maxt ?sn")
case None
hence 12: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 57 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h" using 11 by simp
hence "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 57 + (1+height summary)*70" using "4.IH"(2)[of ?l]
by (meson "4.IH"(2) le_trans nat_add_left_cancel_le)
hence "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 57 + (height (Node (Some (mi, ma)) deg treeList summary))*70"
using height_compose_summary[of summary "Some (mi, ma)" deg treeList] by presburger
then show ?thesis by simp
next
case (Some a)
hence 12: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 55 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h +
1+ 8+ T⇩m⇩a⇩x⇩t (?newlist ! the (vebt_maxt ?sn))"
using "11" by fastforce
hence "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 67 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h "
using maxt_bound[of "?newlist ! the (vebt_maxt ?sn)"] by linarith
hence "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 67 + (1+ height summary)*70"
by (meson "4.IH"(2) le_trans nat_add_left_cancel_le)
hence "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 67 + (height (Node (Some (mi, ma)) deg treeList summary) )*70"
using height_compose_summary[of summary "Some (mi, ma)" deg treeList] by presburger
then show ?thesis by simp
qed
next
case False
hence 11: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 52 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h "
using 10 by simp
hence "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 52 + (1+ height summary)*70"
by (meson "4.IH"(2) le_trans nat_add_left_cancel_le)
hence "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤
52 + (height (Node (Some (mi, ma)) deg treeList summary) )*70" using height_compose_summary[of summary "Some (mi, ma)" deg treeList ]
by (meson add_mono_thms_linordered_semiring(2) le_refl mult_le_mono order_trans)
then show ?thesis by simp
qed
next
case False
hence 6: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 38 + T⇩d⇩e⇩l⇩e⇩t⇩e (treeList ! ?h) ?l +(
T⇩m⇩i⇩n⇩N⇩u⇩l⇩l ?newnode + 2 + (if ?xn = ma then 6+ T⇩m⇩a⇩x⇩t (?newlist ! ?h) else 1))" using 5 by simp
moreover have "invar_vebt (?newlist ! ?h) n"
by (simp add: True ‹invar_vebt (vebt_delete (treeList ! high (the (vebt_mint summary) * 2 ^ (deg div 2) + the (vebt_mint (treeList ! the (vebt_mint summary)))) (deg div 2)) (low (the (vebt_mint summary) * 2 ^ (deg div 2) + the (vebt_mint (treeList ! the (vebt_mint summary)))) (deg div 2))) n›)
ultimately have "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤
43 + T⇩d⇩e⇩l⇩e⇩t⇩e (treeList ! ?h) ?l + (if ?xn = ma then 6+ T⇩m⇩a⇩x⇩t (?newlist ! ?h) else 1)"
using minNull_bound[of ?newnode] by linarith
moreover have " (if ?xn = ma then 6+ T⇩m⇩a⇩x⇩t (?newlist ! ?h) else 1) ≤ 9"
apply(cases "?xn = ma") using maxt_bound[of " (?newlist ! ?h) "] by simp+
ultimately have "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 55 + T⇩d⇩e⇩l⇩e⇩t⇩e (treeList ! ?h) ?l" by force
hence "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤
55 + (1 + height (treeList ! ?h))*70"
by (meson "4.IH"(1) True le_trans nat_add_left_cancel_le nth_mem)
moreover have "treeList ! ?h ∈ set treeList"
using True nth_mem by blast
ultimately have "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤
55 + (height (Node (Some (mi, ma)) deg treeList summary))*70"
using height_compose_child[of "treeList ! ?h" treeList "Some (mi, ma)" deg summary] by presburger
then show ?thesis by simp
qed
next
case False
hence "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x = 3+3 +13+ T⇩m⇩i⇩n⇩t summary +
T⇩m⇩i⇩n⇩t (treeList ! the (vebt_mint summary))+ 7+1 +1" using 3 by simp
hence "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 34" using
mint_bound[of "treeList ! the (vebt_mint summary)"]
mint_bound[of "summary"] by simp
then show ?thesis by simp
qed
next
case False
let ?l = "low x (deg div 2)"
let ?h = "high x (deg div 2)"
have 2: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x =3+3 +13+1 +1 +
(let l = low x (deg div 2);
h = high x (deg div 2) in
if h < length treeList
then( 4 + T⇩d⇩e⇩l⇩e⇩t⇩e (treeList ! h) l +(
let newnode = vebt_delete (treeList ! h) l;
newlist = treeList[h:= newnode]in 1 + T⇩m⇩i⇩n⇩N⇩u⇩l⇩l newnode + (
if minNull newnode
then( 1 + T⇩d⇩e⇩l⇩e⇩t⇩e summary h + (
let sn = vebt_delete summary h in
2+ (if x = ma then 1 + T⇩m⇩a⇩x⇩t sn + (let maxs = vebt_maxt sn in
1 + (if maxs = None
then 1
else 8+ T⇩m⇩a⇩x⇩t (newlist ! the maxs)
) ) else 1) ))else
2 + (if x = ma then 6+ T⇩m⇩a⇩x⇩t (newlist ! h) else 1)
)))else 1 )"
using 1 False by simp
hence 3: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x = 21+(
if ?h < length treeList
then( 4 + T⇩d⇩e⇩l⇩e⇩t⇩e (treeList ! ?h) ?l +(
let newnode = vebt_delete (treeList ! ?h) ?l;
newlist = treeList[?h:= newnode]in 1 + T⇩m⇩i⇩n⇩N⇩u⇩l⇩l newnode + (
if minNull newnode
then( 1 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h + (
let sn = vebt_delete summary ?h in
2+ (if x = ma then 1 + T⇩m⇩a⇩x⇩t sn + (let maxs = vebt_maxt sn in
1 + (if maxs = None
then 1
else 8+ T⇩m⇩a⇩x⇩t (newlist ! the maxs)
) ) else 1) ))else
2 + (if x = ma then 6+ T⇩m⇩a⇩x⇩t (newlist ! ?h) else 1)
)))else 1 )"
apply auto by metis
then show ?thesis
proof(cases "?h < length treeList")
case True
hence "?h < length treeList" by simp
let ?newnode = "vebt_delete (treeList ! ?h) ?l"
let ?newlist = "treeList[?h:= ?newnode]"
have "invar_vebt (treeList ! ?h) n"
using "4.IH"(1) True nth_mem by blast
hence "invar_vebt ?newnode n"
using delete_pres_valid by blast
hence 4: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x = 21+ 4 + T⇩d⇩e⇩l⇩e⇩t⇩e (treeList ! ?h) ?l
+ 1 + T⇩m⇩i⇩n⇩N⇩u⇩l⇩l ?newnode + (
if minNull ?newnode
then( 1 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h + (
let sn = vebt_delete summary ?h in
2+ (if x = ma then 1 + T⇩m⇩a⇩x⇩t sn + (let maxs = vebt_maxt sn in
1 + (if maxs = None
then 1
else 8+ T⇩m⇩a⇩x⇩t (?newlist ! the maxs)
) ) else 1) ))else
2 + (if x = ma then 6+ T⇩m⇩a⇩x⇩t (?newlist ! ?h) else 1))"
using 3 mint_bound[of "treeList ! the (vebt_mint summary)"] mint_bound[of "summary"]
by (smt (z3) True add.assoc)
hence 5: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 26 + T⇩d⇩e⇩l⇩e⇩t⇩e (treeList ! ?h) ?l +
T⇩m⇩i⇩n⇩N⇩u⇩l⇩l ?newnode + (
if minNull ?newnode
then( 1 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h + (
let sn = vebt_delete summary ?h in
2+ (if x = ma then 1 + T⇩m⇩a⇩x⇩t sn + (let maxs = vebt_maxt sn in
1 + (if maxs = None
then 1
else 8+ T⇩m⇩a⇩x⇩t (?newlist ! the maxs)
) ) else 1) ))else
2 + (if x = ma then 6+ T⇩m⇩a⇩x⇩t (?newlist ! ?h) else 1))" by force
then show ?thesis
proof(cases "minNull ?newnode ")
case True
hence 6: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 29 + T⇩d⇩e⇩l⇩e⇩t⇩e (treeList ! ?h) ?l
+ 1 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h + (
let sn = vebt_delete summary ?h in
2+ (if x = ma then 1 + T⇩m⇩a⇩x⇩t sn + (let maxs = vebt_maxt sn in
1 + (if maxs = None
then 1
else 8+ T⇩m⇩a⇩x⇩t (?newlist ! the maxs)
) ) else 1))" using 5 minNull_bound[of ?newnode] by force
have 7: " T⇩d⇩e⇩l⇩e⇩t⇩e (treeList ! ?h) ?l ≤ 9" using True
minNull_delete_time_bound[of "treeList ! ?h"]
using ‹invar_vebt (treeList ! high x (deg div 2)) n› by blast
let ?sn = "vebt_delete summary ?h"
have 8: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 29 + T⇩d⇩e⇩l⇩e⇩t⇩e (treeList ! ?h) ?l
+ 1 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h + (
2+ (if x = ma then 1 + T⇩m⇩a⇩x⇩t ?sn + (let maxs = vebt_maxt ?sn in
1 + (if maxs = None
then 1
else 8+ T⇩m⇩a⇩x⇩t (?newlist ! the maxs)
) ) else 1))"
by (meson "6")
hence 9: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 29 + 9 + 1 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h + 2+
(if x = ma then 1 + T⇩m⇩a⇩x⇩t ?sn + (let maxs = vebt_maxt ?sn in
1 + (if maxs = None
then 1
else 8+ T⇩m⇩a⇩x⇩t (?newlist ! the maxs)
) ) else 1)"
using 6 7 by force
hence 10: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 41 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h +
(if x = ma then 1 + T⇩m⇩a⇩x⇩t ?sn + (let maxs = vebt_maxt ?sn in
1 + (if maxs = None
then 1
else 8+ T⇩m⇩a⇩x⇩t (?newlist ! the maxs)
) ) else 1)"
by simp
then show ?thesis
proof(cases "x = ma")
case True
hence 10: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 41 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h +
1 + T⇩m⇩a⇩x⇩t ?sn + (let maxs = vebt_maxt ?sn in
1 + (if maxs = None
then 1
else 8+ T⇩m⇩a⇩x⇩t (?newlist ! the maxs)
))"
using 10 by (smt (z3) add.assoc trans_le_add1)
hence 11: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 45 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h +
(let maxs = vebt_maxt ?sn in
1 + (if maxs = None
then 1
else 8+ T⇩m⇩a⇩x⇩t (?newlist ! the maxs)
))"
using maxt_bound[of ?sn] by force
then show ?thesis
proof(cases " vebt_maxt ?sn")
case None
hence 12: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 47 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h" using 11 by simp
hence "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 47 + (1+height summary)*70" using "4.IH"(2)[of ?l]
by (meson "4.IH"(2) le_trans nat_add_left_cancel_le)
hence "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 47 + (height (Node (Some (mi, ma)) deg treeList summary))*70"
using height_compose_summary[of summary "Some (mi, ma)" deg treeList] by presburger
then show ?thesis by simp
next
case (Some a)
hence 12: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 45 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h +
1+ 8+ T⇩m⇩a⇩x⇩t (?newlist ! the (vebt_maxt ?sn))"
using "11" by fastforce
hence "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 57 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h "
using maxt_bound[of "?newlist ! the (vebt_maxt ?sn)"] by linarith
hence "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 57 + (1+ height summary)*70"
by (meson "4.IH"(2) le_trans nat_add_left_cancel_le)
hence "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 57 + (height (Node (Some (mi, ma)) deg treeList summary) )*70"
using height_compose_summary[of summary "Some (mi, ma)" deg treeList] by presburger
then show ?thesis by simp
qed
next
case False
hence 11: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 42 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h "
using 10 by simp
hence "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 42 + (1+ height summary)*70"
by (meson "4.IH"(2) le_trans nat_add_left_cancel_le)
hence "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤
42 + (height (Node (Some (mi, ma)) deg treeList summary) )*70" using height_compose_summary[of summary "Some (mi, ma)" deg treeList ]
by (meson add_mono_thms_linordered_semiring(2) le_refl mult_le_mono order_trans)
then show ?thesis by simp
qed
next
case False
hence 6: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 26 + T⇩d⇩e⇩l⇩e⇩t⇩e (treeList ! ?h) ?l +(
T⇩m⇩i⇩n⇩N⇩u⇩l⇩l ?newnode + 2 + (if x = ma then 6+ T⇩m⇩a⇩x⇩t (?newlist ! ?h) else 1))" using 5 by simp
moreover have "invar_vebt (?newlist ! ?h) n"
by (simp add: True ‹invar_vebt (vebt_delete (treeList ! high x (deg div 2)) (low x (deg div 2))) n›)
ultimately have "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤
29 + T⇩d⇩e⇩l⇩e⇩t⇩e (treeList ! ?h) ?l + (if x = ma then 6+ T⇩m⇩a⇩x⇩t (?newlist ! ?h) else 1)"
using minNull_bound[of ?newnode] by linarith
moreover have " (if x = ma then 6+ T⇩m⇩a⇩x⇩t (?newlist ! ?h) else 1) ≤ 9"
apply(cases "x = ma") using maxt_bound[of " (?newlist ! ?h) "] by simp+
ultimately have "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤
38 + T⇩d⇩e⇩l⇩e⇩t⇩e (treeList ! ?h) ?l" by force
hence "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤
38 + (1 + height (treeList ! ?h))*70"
by (meson "4.IH"(1) True le_trans nat_add_left_cancel_le nth_mem)
moreover have "treeList ! ?h ∈ set treeList"
using True nth_mem by blast
ultimately have "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤
38 + (height (Node (Some (mi, ma)) deg treeList summary))*70"
using height_compose_child[of "treeList ! ?h" treeList "Some (mi, ma)" deg summary] by presburger
then show ?thesis by simp
qed
next
case False
hence "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x = 21+1" using 3 by simp
hence "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 22" using
mint_bound[of "treeList ! the (vebt_mint summary)"]
mint_bound[of "summary"] by simp
then show ?thesis by simp
qed
qed
qed
qed
next
case (5 treeList n summary m deg mi ma)
hence deggy: "deg ≥ 2"
by (metis Suc_1 add_mono_thms_linordered_semiring(1) le_add1 plus_1_eq_Suc set_n_deg_not_0)
then show ?case
proof(cases " (x < mi ∨ x > ma)")
case True
hence " T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x = 4" using
T⇩d⇩e⇩l⇩e⇩t⇩e.simps(7)[of mi ma "deg-2" treeList summary x]
by (smt (z3) Suc3_eq_add_3 Suc_1 ‹2 ≤ deg› add_2_eq_Suc' le_add_diff_inverse2 numeral_code(2))
then show ?thesis using T⇩d⇩e⇩l⇩e⇩t⇩e.simps(7)[of mi ma "deg-2" treeList summary x] by auto
next
case False
hence "mi ≤ x ∧ x ≤ ma" by simp
hence 0: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x = 3+3 + (if (x = mi ∧ x = ma) then 3
else 13 + ( if x = mi then T⇩m⇩i⇩n⇩t summary + T⇩m⇩i⇩n⇩t (treeList ! the (vebt_mint summary))+ 7 else 1 )+
(if x = mi then 1 else 1) +
( let xn = (if x = mi
then the (vebt_mint summary) * 2^(deg div 2) + the (vebt_mint (treeList ! the (vebt_mint summary)))
else x);
minn = (if x = mi then xn else mi);
l = low xn (deg div 2);
h = high xn (deg div 2) in
if h < length treeList
then( 4 + T⇩d⇩e⇩l⇩e⇩t⇩e (treeList ! h) l +(
let newnode = vebt_delete (treeList ! h) l;
newlist = treeList[h:= newnode]in 1 + T⇩m⇩i⇩n⇩N⇩u⇩l⇩l newnode + (
if minNull newnode
then( 1 + T⇩d⇩e⇩l⇩e⇩t⇩e summary h + (
let sn = vebt_delete summary h in
2+ (if xn = ma then 1 + T⇩m⇩a⇩x⇩t sn + (let maxs = vebt_maxt sn in
1 + (if maxs = None
then 1
else 8+ T⇩m⇩a⇩x⇩t (newlist ! the maxs)
) )
else 1)
))else
2 + (if xn = ma then 6+ T⇩m⇩a⇩x⇩t (newlist ! h) else 1)
)))else 1 ))" using T⇩d⇩e⇩l⇩e⇩t⇩e.simps(7)[of mi ma "deg-2" treeList summary x] deggy
by (smt (z3) False add.commute add_2_eq_Suc' add_numeral_left le_add_diff_inverse numeral_plus_numeral)
then show ?thesis
proof(cases " (x = mi ∧ x = ma)")
case True
hence "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x = 9" using 0 by simp
then show ?thesis by simp
next
case False
hence 1: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x =3+3 +13+
( if x = mi then T⇩m⇩i⇩n⇩t summary + T⇩m⇩i⇩n⇩t (treeList ! the (vebt_mint summary))+ 7 else 1 )+
(if x = mi then 1 else 1) +
( let xn = (if x = mi
then the (vebt_mint summary) * 2^(deg div 2) + the (vebt_mint (treeList ! the (vebt_mint summary)))
else x);
minn = (if x = mi then xn else mi);
l = low xn (deg div 2);
h = high xn (deg div 2) in
if h < length treeList
then( 4 + T⇩d⇩e⇩l⇩e⇩t⇩e (treeList ! h) l +(
let newnode = vebt_delete (treeList ! h) l;
newlist = treeList[h:= newnode]in 1 + T⇩m⇩i⇩n⇩N⇩u⇩l⇩l newnode + (
if minNull newnode
then( 1 + T⇩d⇩e⇩l⇩e⇩t⇩e summary h + (
let sn = vebt_delete summary h in
2+ (if xn = ma then 1 + T⇩m⇩a⇩x⇩t sn + (let maxs = vebt_maxt sn in
1 + (if maxs = None
then 1
else 8+ T⇩m⇩a⇩x⇩t (newlist ! the maxs)
) )
else 1)
))else
2 + (if xn = ma then 6+ T⇩m⇩a⇩x⇩t (newlist ! h) else 1)
)))else 1 )" using 0
by (simp add: False)
then show ?thesis
proof(cases "x = mi")
case True
let ?xn = " the (vebt_mint summary) * 2^(deg div 2) + the (vebt_mint (treeList ! the (vebt_mint summary)))"
have 2: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x =3+3 +13+ T⇩m⇩i⇩n⇩t summary +
T⇩m⇩i⇩n⇩t (treeList ! the (vebt_mint summary))+ 7+1 +
(let l = low ?xn (deg div 2);
h = high ?xn (deg div 2) in
if h < length treeList
then( 4 + T⇩d⇩e⇩l⇩e⇩t⇩e (treeList ! h) l +(
let newnode = vebt_delete (treeList ! h) l;
newlist = treeList[h:= newnode]in 1 + T⇩m⇩i⇩n⇩N⇩u⇩l⇩l newnode + (
if minNull newnode
then( 1 + T⇩d⇩e⇩l⇩e⇩t⇩e summary h + (
let sn = vebt_delete summary h in
2+ (if ?xn = ma then 1 + T⇩m⇩a⇩x⇩t sn + (let maxs = vebt_maxt sn in
1 + (if maxs = None
then 1
else 8+ T⇩m⇩a⇩x⇩t (newlist ! the maxs)
) ) else 1) ))else
2 + (if ?xn = ma then 6+ T⇩m⇩a⇩x⇩t (newlist ! h) else 1)
)))else 1 )"
using 1 by (smt (z3) True add.assoc)
let ?l = "low ?xn (deg div 2)"
let ?h = "high ?xn (deg div 2)"
have 3: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x = 3+3 +13+ T⇩m⇩i⇩n⇩t summary +
T⇩m⇩i⇩n⇩t (treeList ! the (vebt_mint summary))+ 7+1 +
(if ?h < length treeList
then( 4 + T⇩d⇩e⇩l⇩e⇩t⇩e (treeList ! ?h) ?l +(
let newnode = vebt_delete (treeList ! ?h) ?l;
newlist = treeList[?h:= newnode]in 1 + T⇩m⇩i⇩n⇩N⇩u⇩l⇩l newnode + (
if minNull newnode
then( 1 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h + (
let sn = vebt_delete summary ?h in
2+ (if ?xn = ma then 1 + T⇩m⇩a⇩x⇩t sn + (let maxs = vebt_maxt sn in
1 + (if maxs = None
then 1
else 8+ T⇩m⇩a⇩x⇩t (newlist ! the maxs)
) ) else 1) ))else
2 + (if ?xn = ma then 6+ T⇩m⇩a⇩x⇩t (newlist ! ?h) else 1)
)))else 1 )"
using 2 by meson
then show ?thesis
proof(cases "?h < length treeList")
case True
hence "?h < length treeList" by simp
let ?newnode = "vebt_delete (treeList ! ?h) ?l"
let ?newlist = "treeList[?h:= ?newnode]"
have "invar_vebt (treeList ! ?h) n"
using "5.IH"(1) True nth_mem by blast
hence "invar_vebt ?newnode n"
using delete_pres_valid by blast
have 4: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 37 + T⇩d⇩e⇩l⇩e⇩t⇩e (treeList ! ?h) ?l +(
let newnode = vebt_delete (treeList ! ?h) ?l;
newlist = treeList[?h:= newnode]in 1 + T⇩m⇩i⇩n⇩N⇩u⇩l⇩l newnode + (
if minNull newnode
then( 1 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h + (
let sn = vebt_delete summary ?h in
2+ (if ?xn = ma then 1 + T⇩m⇩a⇩x⇩t sn + (let maxs = vebt_maxt sn in
1 + (if maxs = None
then 1
else 8+ T⇩m⇩a⇩x⇩t (newlist ! the maxs)
) ) else 1) ))else
2 + (if ?xn = ma then 6+ T⇩m⇩a⇩x⇩t (newlist ! ?h) else 1)
))"
using 3 mint_bound[of "treeList ! the (vebt_mint summary)"] mint_bound[of "summary"]
by simp
hence 5: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 38 + T⇩d⇩e⇩l⇩e⇩t⇩e (treeList ! ?h) ?l +(
T⇩m⇩i⇩n⇩N⇩u⇩l⇩l ?newnode + (
if minNull ?newnode
then( 1 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h + (
let sn = vebt_delete summary ?h in
2+ (if ?xn = ma then 1 + T⇩m⇩a⇩x⇩t sn + (let maxs = vebt_maxt sn in
1 + (if maxs = None
then 1
else 8+ T⇩m⇩a⇩x⇩t (?newlist ! the maxs)
) ) else 1) ))else
2 + (if ?xn = ma then 6+ T⇩m⇩a⇩x⇩t (?newlist ! ?h) else 1)
))"
by (smt (z3) Suc_eq_plus1 add.commute add_Suc numeral_plus_one semiring_norm(5) semiring_norm(8))
then show ?thesis
proof(cases "minNull ?newnode ")
case True
hence 6: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 39 + T⇩d⇩e⇩l⇩e⇩t⇩e (treeList ! ?h) ?l
+ 1 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h + (
let sn = vebt_delete summary ?h in
2+ (if ?xn = ma then 1 + T⇩m⇩a⇩x⇩t sn + (let maxs = vebt_maxt sn in
1 + (if maxs = None
then 1
else 8+ T⇩m⇩a⇩x⇩t (?newlist ! the maxs)
) ) else 1))" using 5 minNull_bound[of ?newnode] by presburger
have 7: " T⇩d⇩e⇩l⇩e⇩t⇩e (treeList ! ?h) ?l ≤ 9" using True
minNull_delete_time_bound[of "treeList ! ?h"]
using ‹invar_vebt (treeList ! high (the (vebt_mint summary) * 2 ^ (deg div 2) + the (vebt_mint (treeList ! the (vebt_mint summary)))) (deg div 2)) n› by blast
let ?sn = "vebt_delete summary ?h"
have 8: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 39 + T⇩d⇩e⇩l⇩e⇩t⇩e (treeList ! ?h) ?l
+ 1 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h + (
2+ (if ?xn = ma then 1 + T⇩m⇩a⇩x⇩t ?sn + (let maxs = vebt_maxt ?sn in
1 + (if maxs = None
then 1
else 8+ T⇩m⇩a⇩x⇩t (?newlist ! the maxs)
) ) else 1))"
by (meson "6")
hence 9: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 39 + 9 + 1 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h + 2+
(if ?xn = ma then 1 + T⇩m⇩a⇩x⇩t ?sn + (let maxs = vebt_maxt ?sn in
1 + (if maxs = None
then 1
else 8+ T⇩m⇩a⇩x⇩t (?newlist ! the maxs)
) ) else 1)"
using 6 7 by force
hence 10: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 51 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h +
(if ?xn = ma then 1 + T⇩m⇩a⇩x⇩t ?sn + (let maxs = vebt_maxt ?sn in
1 + (if maxs = None
then 1
else 8+ T⇩m⇩a⇩x⇩t (?newlist ! the maxs)
) ) else 1)"
by simp
then show ?thesis
proof(cases "?xn = ma")
case True
hence 10: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 51 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h +
1 + T⇩m⇩a⇩x⇩t ?sn + (let maxs = vebt_maxt ?sn in
1 + (if maxs = None
then 1
else 8+ T⇩m⇩a⇩x⇩t (?newlist ! the maxs)
))"
using 10 by (smt (z3) add.assoc trans_le_add1)
hence 11: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 55 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h +
(let maxs = vebt_maxt ?sn in
1 + (if maxs = None
then 1
else 8+ T⇩m⇩a⇩x⇩t (?newlist ! the maxs)
))"
using maxt_bound[of ?sn] by force
then show ?thesis
proof(cases " vebt_maxt ?sn")
case None
hence 12: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 57 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h" using 11 by simp
hence "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 57 + (1+height summary)*70" using "5.IH"(2)[of ?l]
by (meson "5.IH"(2) le_trans nat_add_left_cancel_le)
hence "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 57 + (height (Node (Some (mi, ma)) deg treeList summary))*70"
using height_compose_summary[of summary "Some (mi, ma)" deg treeList] by presburger
then show ?thesis by simp
next
case (Some a)
hence 12: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 55 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h +
1+ 8+ T⇩m⇩a⇩x⇩t (?newlist ! the (vebt_maxt ?sn))"
using "11" by fastforce
hence "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 67 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h "
using maxt_bound[of "?newlist ! the (vebt_maxt ?sn)"] by linarith
hence "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 67 + (1+ height summary)*70"
by (meson "5.IH"(2) le_trans nat_add_left_cancel_le)
hence "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 67 + (height (Node (Some (mi, ma)) deg treeList summary) )*70"
using height_compose_summary[of summary "Some (mi, ma)" deg treeList] by presburger
then show ?thesis by simp
qed
next
case False
hence 11: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 52 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h "
using 10 by simp
hence "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 52 + (1+ height summary)*70"
by (meson "5.IH"(2) le_trans nat_add_left_cancel_le)
hence "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤
52 + (height (Node (Some (mi, ma)) deg treeList summary) )*70" using height_compose_summary[of summary "Some (mi, ma)" deg treeList ]
by (meson add_mono_thms_linordered_semiring(2) le_refl mult_le_mono order_trans)
then show ?thesis by simp
qed
next
case False
hence 6: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 38 + T⇩d⇩e⇩l⇩e⇩t⇩e (treeList ! ?h) ?l +(
T⇩m⇩i⇩n⇩N⇩u⇩l⇩l ?newnode + 2 + (if ?xn = ma then 6+ T⇩m⇩a⇩x⇩t (?newlist ! ?h) else 1))" using 5 by simp
moreover have "invar_vebt (?newlist ! ?h) n"
by (simp add: True ‹invar_vebt (vebt_delete (treeList ! high (the (vebt_mint summary) * 2 ^ (deg div 2) + the (vebt_mint (treeList ! the (vebt_mint summary)))) (deg div 2)) (low (the (vebt_mint summary) * 2 ^ (deg div 2) + the (vebt_mint (treeList ! the (vebt_mint summary)))) (deg div 2))) n›)
ultimately have "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤
43 + T⇩d⇩e⇩l⇩e⇩t⇩e (treeList ! ?h) ?l + (if ?xn = ma then 6+ T⇩m⇩a⇩x⇩t (?newlist ! ?h) else 1)"
using minNull_bound[of ?newnode] by linarith
moreover have " (if ?xn = ma then 6+ T⇩m⇩a⇩x⇩t (?newlist ! ?h) else 1) ≤ 9"
apply(cases "?xn = ma") using maxt_bound[of " (?newlist ! ?h) "] by simp+
ultimately have "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 55 + T⇩d⇩e⇩l⇩e⇩t⇩e (treeList ! ?h) ?l" by force
hence "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤
55 + (1 + height (treeList ! ?h))*70"
by (meson "5.IH"(1) True le_trans nat_add_left_cancel_le nth_mem)
moreover have "treeList ! ?h ∈ set treeList"
using True nth_mem by blast
ultimately have "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤
55 + (height (Node (Some (mi, ma)) deg treeList summary))*70"
using height_compose_child[of "treeList ! ?h" treeList "Some (mi, ma)" deg summary] by presburger
then show ?thesis by simp
qed
next
case False
hence "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x = 3+3 +13+ T⇩m⇩i⇩n⇩t summary +
T⇩m⇩i⇩n⇩t (treeList ! the (vebt_mint summary))+ 7+1 +1" using 3 by simp
hence "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 34" using
mint_bound[of "treeList ! the (vebt_mint summary)"]
mint_bound[of "summary"] by simp
then show ?thesis by simp
qed
next
case False
let ?l = "low x (deg div 2)"
let ?h = "high x (deg div 2)"
have 2: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x =3+3 +13+1 +1 +
(let l = low x (deg div 2);
h = high x (deg div 2) in
if h < length treeList
then( 4 + T⇩d⇩e⇩l⇩e⇩t⇩e (treeList ! h) l +(
let newnode = vebt_delete (treeList ! h) l;
newlist = treeList[h:= newnode]in 1 + T⇩m⇩i⇩n⇩N⇩u⇩l⇩l newnode + (
if minNull newnode
then( 1 + T⇩d⇩e⇩l⇩e⇩t⇩e summary h + (
let sn = vebt_delete summary h in
2+ (if x = ma then 1 + T⇩m⇩a⇩x⇩t sn + (let maxs = vebt_maxt sn in
1 + (if maxs = None
then 1
else 8+ T⇩m⇩a⇩x⇩t (newlist ! the maxs)
) ) else 1) ))else
2 + (if x = ma then 6+ T⇩m⇩a⇩x⇩t (newlist ! h) else 1)
)))else 1 )" using 1 False by simp
hence 3: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x = 21+(
if ?h < length treeList
then( 4 + T⇩d⇩e⇩l⇩e⇩t⇩e (treeList ! ?h) ?l +(
let newnode = vebt_delete (treeList ! ?h) ?l;
newlist = treeList[?h:= newnode]in 1 + T⇩m⇩i⇩n⇩N⇩u⇩l⇩l newnode + (
if minNull newnode
then( 1 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h + (
let sn = vebt_delete summary ?h in
2+ (if x = ma then 1 + T⇩m⇩a⇩x⇩t sn + (let maxs = vebt_maxt sn in
1 + (if maxs = None
then 1
else 8+ T⇩m⇩a⇩x⇩t (newlist ! the maxs)
) ) else 1) ))else
2 + (if x = ma then 6+ T⇩m⇩a⇩x⇩t (newlist ! ?h) else 1)
)))else 1 )" apply auto by metis
then show ?thesis
proof(cases "?h < length treeList")
case True
hence "?h < length treeList" by simp
let ?newnode = "vebt_delete (treeList ! ?h) ?l"
let ?newlist = "treeList[?h:= ?newnode]"
have "invar_vebt (treeList ! ?h) n"
using "5.IH"(1) True nth_mem by blast
hence "invar_vebt ?newnode n"
using delete_pres_valid by blast
hence 4: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x = 21+ 4 + T⇩d⇩e⇩l⇩e⇩t⇩e (treeList ! ?h) ?l
+ 1 + T⇩m⇩i⇩n⇩N⇩u⇩l⇩l ?newnode + (
if minNull ?newnode
then( 1 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h + (
let sn = vebt_delete summary ?h in
2+ (if x = ma then 1 + T⇩m⇩a⇩x⇩t sn + (let maxs = vebt_maxt sn in
1 + (if maxs = None
then 1
else 8+ T⇩m⇩a⇩x⇩t (?newlist ! the maxs)
) ) else 1) ))else
2 + (if x = ma then 6+ T⇩m⇩a⇩x⇩t (?newlist ! ?h) else 1))" using 3 mint_bound[of "treeList ! the (vebt_mint summary)"]
mint_bound[of "summary"] by (smt (z3) True add.assoc)
hence 5: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 26 + T⇩d⇩e⇩l⇩e⇩t⇩e (treeList ! ?h) ?l +
T⇩m⇩i⇩n⇩N⇩u⇩l⇩l ?newnode + (
if minNull ?newnode
then( 1 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h + (
let sn = vebt_delete summary ?h in
2+ (if x = ma then 1 + T⇩m⇩a⇩x⇩t sn + (let maxs = vebt_maxt sn in
1 + (if maxs = None
then 1
else 8+ T⇩m⇩a⇩x⇩t (?newlist ! the maxs)
) ) else 1) ))else
2 + (if x = ma then 6+ T⇩m⇩a⇩x⇩t (?newlist ! ?h) else 1))" by force
then show ?thesis
proof(cases "minNull ?newnode ")
case True
hence 6: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 29 + T⇩d⇩e⇩l⇩e⇩t⇩e (treeList ! ?h) ?l
+ 1 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h + (
let sn = vebt_delete summary ?h in
2+ (if x = ma then 1 + T⇩m⇩a⇩x⇩t sn + (let maxs = vebt_maxt sn in
1 + (if maxs = None
then 1
else 8+ T⇩m⇩a⇩x⇩t (?newlist ! the maxs)
) ) else 1))"
using 5 minNull_bound[of ?newnode] by force
have 7: " T⇩d⇩e⇩l⇩e⇩t⇩e (treeList ! ?h) ?l ≤ 9" using True
minNull_delete_time_bound[of "treeList ! ?h"]
using ‹invar_vebt (treeList ! high x (deg div 2)) n› by blast
let ?sn = "vebt_delete summary ?h"
have 8: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 29 + T⇩d⇩e⇩l⇩e⇩t⇩e (treeList ! ?h) ?l
+ 1 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h + (
2+ (if x = ma then 1 + T⇩m⇩a⇩x⇩t ?sn + (let maxs = vebt_maxt ?sn in
1 + (if maxs = None
then 1
else 8+ T⇩m⇩a⇩x⇩t (?newlist ! the maxs)
) ) else 1))"
by (meson "6")
hence 9: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 29 + 9 + 1 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h + 2+
(if x = ma then 1 + T⇩m⇩a⇩x⇩t ?sn + (let maxs = vebt_maxt ?sn in
1 + (if maxs = None
then 1
else 8+ T⇩m⇩a⇩x⇩t (?newlist ! the maxs)
) ) else 1)"
using 6 7 by force
hence 10: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 41 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h +
(if x = ma then 1 + T⇩m⇩a⇩x⇩t ?sn + (let maxs = vebt_maxt ?sn in
1 + (if maxs = None
then 1
else 8+ T⇩m⇩a⇩x⇩t (?newlist ! the maxs)
) ) else 1)"
by simp
then show ?thesis
proof(cases "x = ma")
case True
hence 10: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 41 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h +
1 + T⇩m⇩a⇩x⇩t ?sn + (let maxs = vebt_maxt ?sn in
1 + (if maxs = None
then 1
else 8+ T⇩m⇩a⇩x⇩t (?newlist ! the maxs)
))"
using 10 by (smt (z3) add.assoc trans_le_add1)
hence 11: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 45 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h +
(let maxs = vebt_maxt ?sn in
1 + (if maxs = None
then 1
else 8+ T⇩m⇩a⇩x⇩t (?newlist ! the maxs)
))"
using maxt_bound[of ?sn] by force
then show ?thesis
proof(cases " vebt_maxt ?sn")
case None
hence 12: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 47 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h" using 11 by simp
hence "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 47 + (1+height summary)*70" using "5.IH"(2)[of ?l]
by (meson "5.IH"(2) le_trans nat_add_left_cancel_le)
hence "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 47 + (height (Node (Some (mi, ma)) deg treeList summary))*70"
using height_compose_summary[of summary "Some (mi, ma)" deg treeList] by presburger
then show ?thesis by simp
next
case (Some a)
hence 12: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 45 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h +
1+ 8+ T⇩m⇩a⇩x⇩t (?newlist ! the (vebt_maxt ?sn))"
using "11" by fastforce
hence "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 57 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h "
using maxt_bound[of "?newlist ! the (vebt_maxt ?sn)"] by linarith
hence "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 57 + (1+ height summary)*70"
by (meson "5.IH"(2) le_trans nat_add_left_cancel_le)
hence "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 57 + (height (Node (Some (mi, ma)) deg treeList summary) )*70"
using height_compose_summary[of summary "Some (mi, ma)" deg treeList] by presburger
then show ?thesis by simp
qed
next
case False
hence 11: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 42 + T⇩d⇩e⇩l⇩e⇩t⇩e summary ?h "
using 10 by simp
hence "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 42 + (1+ height summary)*70"
by (meson "5.IH"(2) le_trans nat_add_left_cancel_le)
hence "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤
42 + (height (Node (Some (mi, ma)) deg treeList summary) )*70"
using height_compose_summary[of summary "Some (mi, ma)" deg treeList ]
by (meson add_mono_thms_linordered_semiring(2) le_refl mult_le_mono order_trans)
then show ?thesis by simp
qed
next
case False
hence 6: "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 26 + T⇩d⇩e⇩l⇩e⇩t⇩e (treeList ! ?h) ?l +(
T⇩m⇩i⇩n⇩N⇩u⇩l⇩l ?newnode + 2 + (if x = ma then 6+ T⇩m⇩a⇩x⇩t (?newlist ! ?h) else 1))" using 5 by simp
moreover have "invar_vebt (?newlist ! ?h) n"
by (simp add: True ‹invar_vebt (vebt_delete (treeList ! high x (deg div 2)) (low x (deg div 2))) n›)
ultimately have "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤
29 + T⇩d⇩e⇩l⇩e⇩t⇩e (treeList ! ?h) ?l + (if x = ma then 6+ T⇩m⇩a⇩x⇩t (?newlist ! ?h) else 1)"
using minNull_bound[of ?newnode] by linarith
moreover have " (if x = ma then 6+ T⇩m⇩a⇩x⇩t (?newlist ! ?h) else 1) ≤ 9"
apply(cases "x = ma") using maxt_bound[of " (?newlist ! ?h) "] by simp+
ultimately have "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤
38 + T⇩d⇩e⇩l⇩e⇩t⇩e (treeList ! ?h) ?l" by force
hence "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤
38 + (1 + height (treeList ! ?h))*70"
by (meson "5.IH"(1) True le_trans nat_add_left_cancel_le nth_mem)
moreover have "treeList ! ?h ∈ set treeList"
using True nth_mem by blast
ultimately have "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤
38 + (height (Node (Some (mi, ma)) deg treeList summary))*70"
using height_compose_child[of "treeList ! ?h" treeList "Some (mi, ma)" deg summary]
by presburger
then show ?thesis by simp
qed
next
case False
hence "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x = 21+1" using 3 by simp
hence "T⇩d⇩e⇩l⇩e⇩t⇩e (Node (Some (mi, ma)) deg treeList summary) x ≤ 22" using
mint_bound[of "treeList ! the (vebt_mint summary)"]
mint_bound[of "summary"] by simp
then show ?thesis by simp
qed
qed
qed
qed
qed
theorem delete_bound_size_univ: "invar_vebt t n ⟹ u = 2^n ⟹ T⇩d⇩e⇩l⇩e⇩t⇩e t x ≤ 140 + 70 * lb (lb u)"
using delete_bound_height[of t n x] height_double_log_univ_size[of u n t] by simp
fun T⇩d⇩e⇩l⇩e⇩t⇩e'::"VEBT ⇒ nat ⇒ nat" where
"T⇩d⇩e⇩l⇩e⇩t⇩e' (Leaf a b) 0 = 1"|
"T⇩d⇩e⇩l⇩e⇩t⇩e' (Leaf a b) (Suc 0) = 1"|
"T⇩d⇩e⇩l⇩e⇩t⇩e' (Leaf a b) (Suc (Suc n)) = 1"|
"T⇩d⇩e⇩l⇩e⇩t⇩e' (Node None deg treeList summary) _ = 1"|
"T⇩d⇩e⇩l⇩e⇩t⇩e' (Node (Some (mi, ma)) 0 treeList summary) x = 1"|
"T⇩d⇩e⇩l⇩e⇩t⇩e' (Node (Some (mi, ma)) (Suc 0) treeList summary) x =1 "|
"T⇩d⇩e⇩l⇩e⇩t⇩e' (Node (Some (mi, ma)) deg treeList summary) x = (
if (x < mi ∨ x > ma) then 1
else if (x = mi ∧ x = ma) then 1
else ( let xn = (if x = mi
then the (vebt_mint summary) * 2^(deg div 2) + the (vebt_mint (treeList ! the (vebt_mint summary)))
else x);
minn = (if x = mi then xn else mi);
l = low xn (deg div 2);
h = high xn (deg div 2) in
if h < length treeList
then( T⇩d⇩e⇩l⇩e⇩t⇩e' (treeList ! h) l +(
let newnode = vebt_delete (treeList ! h) l;
newlist = treeList[h:= newnode]in
if minNull newnode
then T⇩d⇩e⇩l⇩e⇩t⇩e' summary h
else 1
))else 1 ))"
lemma tdeletemimi':"deg ≥ 2 ⟹ T⇩d⇩e⇩l⇩e⇩t⇩e' (Node (Some (mi, mi)) deg treeList summary) x ≤ 1"
using T⇩d⇩e⇩l⇩e⇩t⇩e'.simps(7)[of mi mi "deg-2" treeList summary x]
apply(cases "x ≠ mi")
apply (metis add_2_eq_Suc' le_add_diff_inverse2 le_eq_less_or_eq linorder_neqE_nat)
by (metis add_2_eq_Suc' eq_imp_le le_add_diff_inverse2)
lemma minNull_delete_time_bound': "invar_vebt t n ⟹ minNull (vebt_delete t x) ⟹ T⇩d⇩e⇩l⇩e⇩t⇩e' t x ≤ 1"
proof(induction t n rule: invar_vebt.induct)
case (1 a b)
then show ?case
by (metis T⇩d⇩e⇩l⇩e⇩t⇩e'.simps(1) T⇩d⇩e⇩l⇩e⇩t⇩e'.simps(2) T⇩d⇩e⇩l⇩e⇩t⇩e'.simps(3) vebt_buildup.cases order_refl)
next
case (4 treeList n summary m deg mi ma)
hence "deg ≥ 2"
by (metis add_self_div_2 deg_not_0 div_greater_zero_iff)
then show ?case
proof(cases "(x < mi ∨ x > ma)")
case True
then show ?thesis
using "4.prems" ‹2 ≤ deg› delt_out_of_range by force
next
case False
hence "x ≤ ma ∧ x ≥ mi" by simp
then show ?thesis
proof(cases "(x = mi ∧ x = ma)")
case True
then show ?thesis
using ‹2 ≤ deg› tdeletemimi' by blast
next
case False
hence "¬ (x = mi ∧ x = ma)" by simp
then show ?thesis
proof(cases "x = mi")
case True
hence "x = mi" by simp
let ?xn = "the (vebt_mint summary) * 2^(deg div 2)
+ the (vebt_mint (treeList ! the (vebt_mint summary)))"
let ?l = "low ?xn (deg div 2)"
let ?h = "high ?xn (deg div 2)"
have "∃ y. both_member_options summary y"
using "4.hyps"(4) "4.hyps"(5) "4.hyps"(8) "4.hyps"(9) False True high_bound_aux by blast
then obtain i where aa:" (vebt_mint summary) = Some i"
by (metis "4.hyps"(1) Collect_empty_eq mint_corr_help_empty not_Some_eq set_vebt'_def valid_member_both_member_options)
hence "∃ y. both_member_options (treeList ! i ) y"
by (meson "4.hyps"(1) "4.hyps"(5) both_member_options_equiv_member member_bound mint_member)
hence "∃ y. both_member_options (treeList ! the (vebt_mint summary) ) y"
using ‹vebt_mint summary = Some i› by auto
hence "invar_vebt (treeList ! the (vebt_mint summary)) n"
by (metis "4.IH"(1) "4.hyps"(1) "4.hyps"(2) ‹vebt_mint summary = Some i› option.sel member_bound mint_member nth_mem)
then obtain y where "(vebt_mint (treeList ! the (vebt_mint summary))) = Some y"
by (metis Collect_empty_eq ‹∃y. both_member_options (treeList ! the (vebt_mint summary)) y› mint_corr_help_empty option.exhaust set_vebt'_def valid_member_both_member_options)
have "y < 2^n ∧ i < 2^m"
using "4.hyps"(1) ‹vebt_mint (treeList ! the (vebt_mint summary)) = Some y› ‹invar_vebt (treeList ! the (vebt_mint summary)) n› aa member_bound mint_member by blast
hence "?h ≤ 2^m" using aa
using "4.hyps"(3) "4.hyps"(4) ‹vebt_mint (treeList ! the (vebt_mint summary)) = Some y› high_inv by force
have 0:"vebt_delete (Node (Some (mi, ma)) deg treeList summary) x =(
let newnode = vebt_delete (treeList ! ?h) ?l;
newlist = treeList[?h:= newnode]in
if minNull newnode
then(
let sn = vebt_delete summary ?h in
(Node (Some (?xn, if ?xn = ma then (let maxs = vebt_maxt sn in
(if maxs = None
then ?xn
else 2^(deg div 2) * the maxs
+ the (vebt_maxt (newlist ! the maxs))
) )
else ma))
deg newlist sn)
)else
(Node (Some (?xn, (if ?xn = ma then
?h * 2^(deg div 2) + the( vebt_maxt (newlist ! ?h))
else ma)))
deg newlist summary ))
" using del_x_mi[of x mi ma deg ?xn ?h summary treeList ?l]
using "4.hyps"(2) "4.hyps"(3) "4.hyps"(4) "4.hyps"(7) False True ‹2 ≤ deg› ‹vebt_mint (treeList ! the (vebt_mint summary)) = Some y› ‹y < 2 ^ n ∧ i < 2 ^ m› aa high_inv by fastforce
let ?newnode = "vebt_delete (treeList ! ?h) ?l"
let ?newlist = "treeList[?h:= ?newnode]"
show ?thesis
proof(cases "minNull ?newnode")
case True
then show ?thesis
by (smt (z3) "0" "4.prems" minNull.simps(5))
next
case False
then show ?thesis
by (smt (z3) "0" "4.prems" minNull.simps(5))
qed
next
case False
hence "x > mi"
using ‹x ≤ ma ∧ mi ≤ x› nat_less_le by blast
let ?l = "low x (deg div 2)"
let ?h = "high x (deg div 2)"
let ?newnode = "vebt_delete (treeList ! ?h) ?l"
let ?newlist = "treeList[?h:= ?newnode]"
have "?h < length treeList"
using "4.hyps"(2) "4.hyps"(3) "4.hyps"(4) "4.hyps"(8) ‹x ≤ ma ∧ mi ≤ x› high_bound_aux by auto
hence 0:"vebt_delete (Node (Some (mi, ma)) deg treeList summary) x = (
if minNull ?newnode
then(
let sn = vebt_delete summary ?h in
(Node (Some (mi, if x = ma then (let maxs = vebt_maxt sn in
(if maxs = None
then mi
else 2^(deg div 2) * the maxs
+ the (vebt_maxt (?newlist ! the maxs))
)
)
else ma))
deg ?newlist sn)
)else
(Node (Some (mi, (if x = ma then
?h * 2^(deg div 2) + the( vebt_maxt (?newlist ! ?h))
else ma)))
deg ?newlist summary ))" using del_x_not_mi[of mi x ma deg ?h ?l ?newnode ?newlist treeList summary]
by (metis ‹2 ≤ deg› ‹mi < x› ‹x ≤ ma ∧ mi ≤ x› del_x_not_mi leD)
then show ?thesis
proof(cases " minNull ?newnode ")
case True
then show ?thesis
by (metis "0" "4.prems" minNull.simps(5))
next
case False
then show ?thesis
using "0" "4.prems" by fastforce
qed
qed
qed
qed
next
case (5 treeList n summary m deg mi ma)
hence "deg ≥ 2"
by (metis Suc_1 add_mono_thms_linordered_semiring(1) le_add1 plus_1_eq_Suc set_n_deg_not_0)
then show ?case
proof(cases "(x < mi ∨ x > ma)")
case True
then show ?thesis
using "5.prems" ‹2 ≤ deg› delt_out_of_range by force
next
case False
hence "x ≤ ma ∧ x ≥ mi" by simp
then show ?thesis
proof(cases "(x = mi ∧ x = ma)")
case True
then show ?thesis
using ‹2 ≤ deg› tdeletemimi' by blast
next
case False
hence "¬ (x = mi ∧ x = ma)" by simp
then show ?thesis
proof(cases "x = mi")
case True
hence "x = mi" by simp
let ?xn = "the (vebt_mint summary) * 2^(deg div 2)
+ the (vebt_mint (treeList ! the (vebt_mint summary)))"
let ?l = "low ?xn (deg div 2)"
let ?h = "high ?xn (deg div 2)"
have "∃ y. both_member_options summary y"
using "5.hyps"(4) "5.hyps"(5) "5.hyps"(8) "5.hyps"(9) False True high_bound_aux by blast
then obtain i where aa:" (vebt_mint summary) = Some i"
by (metis "5.hyps"(1) Collect_empty_eq mint_corr_help_empty not_Some_eq set_vebt'_def valid_member_both_member_options)
hence "∃ y. both_member_options (treeList ! i ) y"
by (meson "5.hyps"(1) "5.hyps"(5) both_member_options_equiv_member member_bound mint_member)
hence "∃ y. both_member_options (treeList ! the (vebt_mint summary) ) y"
using ‹vebt_mint summary = Some i› by auto
hence "invar_vebt (treeList ! the (vebt_mint summary)) n"
by (metis "5.IH"(1) "5.hyps"(1) "5.hyps"(2) ‹vebt_mint summary = Some i› option.sel member_bound mint_member nth_mem)
then obtain y where "(vebt_mint (treeList ! the (vebt_mint summary))) = Some y"
by (metis Collect_empty_eq ‹∃y. both_member_options (treeList ! the (vebt_mint summary)) y› mint_corr_help_empty option.exhaust set_vebt'_def valid_member_both_member_options)
have "y < 2^n ∧ i < 2^m"
using "5.hyps"(1) ‹vebt_mint (treeList ! the (vebt_mint summary)) = Some y› ‹invar_vebt (treeList ! the (vebt_mint summary)) n› aa member_bound mint_member by blast
hence "?h ≤ 2^m" using aa
using "5.hyps"(3) "5.hyps"(4) ‹vebt_mint (treeList ! the (vebt_mint summary)) = Some y› high_inv by force
have 0:"vebt_delete (Node (Some (mi, ma)) deg treeList summary) x =(
let newnode = vebt_delete (treeList ! ?h) ?l;
newlist = treeList[?h:= newnode]in
if minNull newnode
then(
let sn = vebt_delete summary ?h in
(Node (Some (?xn, if ?xn = ma then (let maxs = vebt_maxt sn in
(if maxs = None
then ?xn
else 2^(deg div 2) * the maxs
+ the (vebt_maxt (newlist ! the maxs))
)
)
else ma))
deg newlist sn)
)else
(Node (Some (?xn, (if ?xn = ma then
?h * 2^(deg div 2) + the( vebt_maxt (newlist ! ?h))
else ma)))
deg newlist summary ))
" using del_x_mi[of x mi ma deg ?xn ?h summary treeList ?l]
using "5.hyps"(2) "5.hyps"(3) "5.hyps"(4) "5.hyps"(7) False True ‹2 ≤ deg› ‹vebt_mint (treeList ! the (vebt_mint summary)) = Some y› ‹y < 2 ^ n ∧ i < 2 ^ m› aa high_inv by fastforce
let ?newnode = "vebt_delete (treeList ! ?h) ?l"
let ?newlist = "treeList[?h:= ?newnode]"
show ?thesis
proof(cases "minNull ?newnode")
case True
then show ?thesis
by (smt (z3) "0" "5.prems" minNull.simps(5))
next
case False
then show ?thesis
by (smt (z3) "0" "5.prems" minNull.simps(5))
qed
next
case False
hence "x > mi"
using ‹x ≤ ma ∧ mi ≤ x› nat_less_le by blast
let ?l = "low x (deg div 2)"
let ?h = "high x (deg div 2)"
let ?newnode = "vebt_delete (treeList ! ?h) ?l"
let ?newlist = "treeList[?h:= ?newnode]"
have "x <2^deg"
using "5.hyps"(8) ‹x ≤ ma ∧ mi ≤ x› dual_order.strict_trans2 by blast
hence "?h < 2^m" using "5.prems" ‹2 ≤ deg› ‹mi < x› ‹x ≤ ma ∧ mi ≤ x›
del_in_range minNull.simps(5) verit_comp_simplify1(3) apply simp
by (smt (z3) minNull.simps(5))
hence 0:"vebt_delete (Node (Some (mi, ma)) deg treeList summary) x = (
if minNull ?newnode
then(
let sn = vebt_delete summary ?h in
(Node (Some (mi, if x = ma then (let maxs = vebt_maxt sn in
(if maxs = None
then mi
else 2^(deg div 2) * the maxs
+ the (vebt_maxt (?newlist ! the maxs))
)
)
else ma))
deg ?newlist sn)
)else
(Node (Some (mi, (if x = ma then
?h * 2^(deg div 2) + the( vebt_maxt (?newlist ! ?h))
else ma)))
deg ?newlist summary ))" using del_x_not_mi[of mi x ma deg ?h ?l ?newnode ?newlist treeList summary]
by (metis "5.hyps"(2) ‹2 ≤ deg› ‹mi < x› ‹x ≤ ma ∧ mi ≤ x› del_x_not_mi leD)
then show ?thesis
proof(cases " minNull ?newnode ")
case True
then show ?thesis
by (metis "0" "5.prems" minNull.simps(5))
next
case False
then show ?thesis
using "0" "5.prems" by fastforce
qed
qed
qed
qed
qed simp+
lemma delete_bound_height': "invar_vebt t n ⟹ T⇩d⇩e⇩l⇩e⇩t⇩e' t x ≤ 1+ height t"
proof(induction t n arbitrary: x rule: invar_vebt.induct)
case (1 a b)
then show ?case
apply(cases "x ≤ 0")
apply simp
apply(cases "x = 1")
apply simp
using T⇩d⇩e⇩l⇩e⇩t⇩e'.simps(3)[of a b "x-2"] height.simps(1)[of a b]
by (metis One_nat_def T⇩d⇩e⇩l⇩e⇩t⇩e'.simps(3) vebt_buildup.cases lessI less_Suc_eq_le plus_1_eq_Suc)
next
case (4 treeList n summary m deg mi ma)
hence "deg ≥2"
by (metis Suc_leI add_2_eq_Suc' add_Suc_shift add_le_mono deg_not_0 numeral_2_eq_2)
then show ?case
proof(cases "(x < mi ∨ x > ma)")
case True
then show ?thesis
by (metis One_nat_def Suc_1 T⇩d⇩e⇩l⇩e⇩t⇩e'.simps(7) ‹2 ≤ deg› add_leD2 vebt_buildup.cases le_add1 lessI not_less plus_1_eq_Suc)
next
case False
hence miama:"mi ≤ x ∧ x ≤ ma" by simp
then show ?thesis
proof(cases "x = mi ∧ x = ma")
case True
then show ?thesis using T⇩d⇩e⇩l⇩e⇩t⇩e'.simps(7)[of mi ma "deg-2" treeList summary x] ‹2 ≤ deg› tdeletemimi' trans_le_add1 by blast
next
case False
let ?xn = "(if x = mi
then the (vebt_mint summary) * 2^(deg div 2) + the (vebt_mint (treeList ! the (vebt_mint summary)))
else x)"
let ?minn = "(if x = mi then ?xn else mi)"
let ?l = "low ?xn (deg div 2)"
let ?h = "high ?xn (deg div 2)"
have 0:"T⇩d⇩e⇩l⇩e⇩t⇩e' (Node (Some (mi, ma)) deg treeList summary) x = (if ?h < length treeList
then( T⇩d⇩e⇩l⇩e⇩t⇩e' (treeList ! ?h) ?l +(
let newnode = vebt_delete (treeList ! ?h) ?l;
newlist = treeList[?h:= newnode]in
if minNull newnode
then T⇩d⇩e⇩l⇩e⇩t⇩e' summary ?h
else 1
))else 1)"
using T⇩d⇩e⇩l⇩e⇩t⇩e'.simps(7)[of mi ma "deg-2" treeList summary x] ‹2 ≤ deg› False miama
by (smt (z3) add_2_eq_Suc le_add_diff_inverse not_less)
then show ?thesis
proof(cases "?h< length treeList")
case True
let ?newnode = "vebt_delete (treeList ! ?h) ?l"
let ?newlist = "treeList[?h:= ?newnode]"
have 1:"T⇩d⇩e⇩l⇩e⇩t⇩e' (Node (Some (mi, ma)) deg treeList summary) x =
T⇩d⇩e⇩l⇩e⇩t⇩e' (treeList ! ?h) ?l +(
if minNull ?newnode
then T⇩d⇩e⇩l⇩e⇩t⇩e' summary ?h
else 1 )" using 0 True by simp
then show ?thesis
proof(cases "minNull ?newnode")
case True
hence " T⇩d⇩e⇩l⇩e⇩t⇩e' (treeList ! ?h) ?l ≤ 1"
by (metis "0" "1" "4.IH"(1) minNull_delete_time_bound' nat_le_iff_add nth_mem)
hence "T⇩d⇩e⇩l⇩e⇩t⇩e' (Node (Some (mi, ma)) deg treeList summary) x ≤ 1+ T⇩d⇩e⇩l⇩e⇩t⇩e' summary ?h" using 1 True by auto
hence "T⇩d⇩e⇩l⇩e⇩t⇩e' (Node (Some (mi, ma)) deg treeList summary) x ≤ 1+1+ height summary" using 4(2)[of ?h] by simp
then show ?thesis
using order_trans by fastforce
next
case False
hence "T⇩d⇩e⇩l⇩e⇩t⇩e' (Node (Some (mi, ma)) deg treeList summary) x =
1+ T⇩d⇩e⇩l⇩e⇩t⇩e' (treeList ! ?h) ?l " using 1 by simp
moreover have 2:" (treeList ! ?h) ∈set treeList"
by (meson True nth_mem)
ultimately have "T⇩d⇩e⇩l⇩e⇩t⇩e' (Node (Some (mi, ma)) deg treeList summary) x ≤ 1 + 1+ height (treeList ! ?h)"
using 4(1) by simp
then show ?thesis
by (smt (z3) "2" Suc_eq_plus1_left Suc_le_mono add_2_eq_Suc dual_order.trans height_compose_child nat_1_add_1)
qed
qed (simp add : 0)
qed
qed
next
case (5 treeList n summary m deg mi ma)
hence "deg ≥2"
by (metis Suc_1 Suc_eq_plus1 add_mono_thms_linordered_semiring(1) le_add2 set_n_deg_not_0)
then show ?case
proof(cases "(x < mi ∨ x > ma)")
case True
then show ?thesis
by (metis One_nat_def Suc_1 T⇩d⇩e⇩l⇩e⇩t⇩e'.simps(7) ‹2 ≤ deg› add_leD2 vebt_buildup.cases le_add1 lessI not_less plus_1_eq_Suc)
next
case False
hence miama:"mi ≤ x ∧ x ≤ ma" by simp
then show ?thesis
proof(cases "x = mi ∧ x = ma")
case True
then show ?thesis using T⇩d⇩e⇩l⇩e⇩t⇩e'.simps(7)[of mi ma "deg-2" treeList summary x] ‹2 ≤ deg› tdeletemimi' trans_le_add1 by blast
next
case False
let ?xn = "(if x = mi
then the (vebt_mint summary) * 2^(deg div 2) + the (vebt_mint (treeList ! the (vebt_mint summary)))
else x)"
let ?minn = "(if x = mi then ?xn else mi)"
let ?l = "low ?xn (deg div 2)"
let ?h = "high ?xn (deg div 2)"
have 0:"T⇩d⇩e⇩l⇩e⇩t⇩e' (Node (Some (mi, ma)) deg treeList summary) x = (if ?h < length treeList
then( T⇩d⇩e⇩l⇩e⇩t⇩e' (treeList ! ?h) ?l +(
let newnode = vebt_delete (treeList ! ?h) ?l;
newlist = treeList[?h:= newnode]in
if minNull newnode
then T⇩d⇩e⇩l⇩e⇩t⇩e' summary ?h
else 1
))else 1)"
using T⇩d⇩e⇩l⇩e⇩t⇩e'.simps(7)[of mi ma "deg-2" treeList summary x] ‹2 ≤ deg› False miama
by (smt (z3) add_2_eq_Suc le_add_diff_inverse not_less)
then show ?thesis
proof(cases "?h< length treeList")
case True
let ?newnode = "vebt_delete (treeList ! ?h) ?l"
let ?newlist = "treeList[?h:= ?newnode]"
have 1:"T⇩d⇩e⇩l⇩e⇩t⇩e' (Node (Some (mi, ma)) deg treeList summary) x =
T⇩d⇩e⇩l⇩e⇩t⇩e' (treeList ! ?h) ?l +(
if minNull ?newnode
then T⇩d⇩e⇩l⇩e⇩t⇩e' summary ?h
else 1 )" using 0 True by simp
then show ?thesis
proof(cases "minNull ?newnode")
case True
hence " T⇩d⇩e⇩l⇩e⇩t⇩e' (treeList ! ?h) ?l ≤ 1"
by (metis "0" "1" "5.IH"(1) minNull_delete_time_bound' nat_le_iff_add nth_mem)
hence "T⇩d⇩e⇩l⇩e⇩t⇩e' (Node (Some (mi, ma)) deg treeList summary) x ≤ 1+ T⇩d⇩e⇩l⇩e⇩t⇩e' summary ?h" using 1 True by auto
hence "T⇩d⇩e⇩l⇩e⇩t⇩e' (Node (Some (mi, ma)) deg treeList summary) x ≤ 1+1+ height summary" using 5(2)[of ?h] by simp
then show ?thesis
using order_trans by fastforce
next
case False
hence "T⇩d⇩e⇩l⇩e⇩t⇩e' (Node (Some (mi, ma)) deg treeList summary) x =
1+ T⇩d⇩e⇩l⇩e⇩t⇩e' (treeList ! ?h) ?l " using 1 by simp
moreover have 2:" (treeList ! ?h) ∈set treeList"
by (meson True nth_mem)
ultimately have "T⇩d⇩e⇩l⇩e⇩t⇩e' (Node (Some (mi, ma)) deg treeList summary) x ≤ 1 + 1+ height (treeList ! ?h)"
using 5(1) by simp
then show ?thesis
by (smt (z3) "2" Suc_eq_plus1_left Suc_le_mono add_2_eq_Suc dual_order.trans height_compose_child nat_1_add_1)
qed
qed (simp add : 0)
qed
qed
qed simp+
theorem delete_bound_size_univ': "invar_vebt t n ⟹ u = 2^n ⟹ T⇩d⇩e⇩l⇩e⇩t⇩e' t x ≤ 2 + lb (lb u)"
using delete_bound_height'[of t n x] height_double_log_univ_size[of u n t] by simp
end
end
Theory VEBT_Space
theory VEBT_Space imports VEBT_Definitions Complex_Main
begin
section ‹Space Complexity and $buildup$ Time Consumption›
subsection ‹Space Comlexity of valid van Emde Boas Trees›
text ‹Space Complexity is linear in relation to universe sizes›
context VEBT_internal begin
fun space:: "VEBT ⇒ nat" where
"space (Leaf a b) = 3"|
"space (Node info deg treeList summary) = 5 + space summary + length treeList + foldr (λ a b. a+b) (map space treeList) 0"
fun space':: "VEBT ⇒ nat" where
"space' (Leaf a b) = 4"|
"space' (Node info deg treeList summary) = 6 + space' summary + foldr (λ a b. a+b) (map space' treeList) 0"
text ‹Count in reals›
fun cnt:: "VEBT ⇒ real" where
"cnt (Leaf a b) = 1"|
"cnt (Node info deg treeList summary) = 1 + cnt summary + foldr (λ a b. a+b) (map cnt treeList) 0"
subsection ‹Auxiliary Lemmas for List Summation›
lemma list_every_elemnt_bound_sum_bound:"∀ x ∈ set xs. f x ≤ bound ⟹ foldr (λ a b. a+b) (map f xs) i ≤ length xs * bound + i"
by(induction xs) auto
lemma list_every_elemnt_bound_sum_bound_real:"∀ x ∈ set (xs::'a list). (f::'a⇒real) x ≤ (bound::real) ⟹ foldr (λ a b. a+b) (map f xs) i ≤ real(length xs) * bound + i"
apply(induction xs) apply simp
apply (simp add: algebra_simps)
done
lemma foldr_one: "d ≤ foldr (+) ys (d::nat)"
by (induction ys) auto
lemma foldr_zero: "∀ i < length xs. xs ! i > 0 ⟹
foldr (λ a b. a+b) xs (d::nat) - d ≥ length xs"
proof(induction xs)
case Nil
then show ?case by simp
next
case (Cons a xs)
hence "∀i<length xs. 0 < xs ! i"
by auto
hence " length xs ≤ foldr (+) xs d - d" using Cons.IH by simp
have "a ≥ 1"
by (metis gr0_conv_Suc length_Cons less_one local.Cons(2) not_gr0 not_less nth_Cons_0)
then show ?case
by (metis Nat.add_diff_assoc ‹length xs ≤ foldr (+) xs d - d› add_mono_thms_linordered_semiring(1) foldr.simps(2) foldr_one length_Cons o_apply plus_1_eq_Suc)
qed
lemma foldr_mono: "length xs = length ys ⟹∀ i < length xs. xs ! i < ys ! i ⟹ c ≤ d ⟹
foldr (λ a b. a+b) xs c + length ys ≤ foldr (λ a b. a+b) ys (d::nat)"
proof(induction xs arbitrary: d c ys)
case Nil
then show ?case using length_0_conv list.size(3) foldr_one by simp
next
case (Cons a xs)
then obtain y ys1 where "ys = y #ys1"
by (metis Suc_leI Suc_le_length_iff nth_equalityI)
hence 0:"length xs = length ys1"
using Cons.prems(1) by force
hence 1:"∀i<length xs. xs ! i < ys1 ! i" using Cons.prems(2)
using ‹ys = y # ys1› by force
hence 3: "∀i<length ys1. ys1 ! i > 0"
by (metis "0" less_nat_zero_code neq0_conv)
have "foldr (+) (a # xs)c = a +foldr (+) xs (c)" by simp
have "foldr (+) (ys) d = y +foldr (+) ys1 (d)"
by (simp add: ‹ys = y # ys1›)
have 2:"a < y" using Cons.prems(2) ‹ys = y # ys1›
by (metis length_Cons nth_Cons_0 zero_less_Suc)
have 4:"foldr (+) xs c ≤ foldr (+) ys1 d - length ys1"
using Cons.IH[of ys1 c d] 0 1 Cons.prems(3) by simp
have "foldr (+) ys1 d ≥ length ys1"using foldr_zero[of ys1 d] 3 by simp
hence "a + foldr (+) xs c < y + foldr (+) ys1 d - length ys1 " using 2 foldr_zero[of ys1 d] 4 by simp
then show ?case
using ‹ys = y # ys1› by auto
qed
lemma two_realpow_ge_two :"(n::real)≥ 1 ⟹ (2::real)^n ≥ 2"
by (metis less_one not_less of_nat_1 of_nat_le_iff of_nat_numeral power_increasing power_one_right zero_neq_numeral)
lemma foldr0: "foldr (+) xs (c+d) = foldr (+) xs (d::real) + c"
by(induction xs) auto
lemma f_g_map_foldr_bound:" (∀ x ∈ set xs. f x ≤ c * g x)
⟹ foldr (λ a b. a+b) (map f xs) d ≤ c * foldr (λ a b. a+b) (map g xs) (0::real) + d"
by(induction xs) (auto simp add: algebra_simps)
lemma real_nat_list: "real (foldr (+) ( map f xs) (c::nat))
= foldr (+) (map (λ x. real(f x))xs) c"
by(induction xs arbitrary: c) auto
subsection ‹Actual Space Reasoning›
lemma space_space': "space' t > space t"
proof(induction t)
case (Node info deg treeList summary)
hence "∀ i < length treeList . (map space treeList)!i < ( map space' treeList)!i"
by simp
hence 0:"foldr (+) (map space treeList) 0 + length treeList ≤ foldr (+) (map space' treeList) 0 "
using foldr_mono[of "(map space treeList)" "(map space' treeList)" 0 0] by simp
have 1:"space summary < space' summary" using Node by simp
hence "foldr (+) (map space treeList) 0 + length treeList + space summary ≤
foldr (+) (map space' treeList) 0 + space' summary" using 0 by simp
then show ?case using space'.simps(2)[of info deg treeList summary]
space.simps(2)[of info deg treeList summary] by simp
qed simp
lemma cnt_bound:
defines "c ≡ 1.5"
shows "invar_vebt t n ⟹ cnt t ≤ 2*((2^n - c)::real)"
proof(induction t n rule: invar_vebt.induct)
case (2 treeList n summary m deg)
hence "∀t∈set treeList. (cnt t) ≤ 2 * (2 ^ n - c)" by simp
hence " foldr (λ a b. a+b) (map cnt treeList) 0 ≤ 2^n*2 * ((2^n - c)::real)"
using list_every_elemnt_bound_sum_bound_real[of treeList cnt "2*((2^n - c)::real)" 0 ] 2
by (auto simp add: algebra_simps)
hence "cnt ( Node None deg treeList summary) ≤ 2*(2^n+1)*(2^n-c) + 1" using 2
by(auto simp add: algebra_simps)
hence "cnt ( Node None deg treeList summary) ≤ 2*(2^(n+n) + (1-c)*2^n - c + 1/2)"
by(auto simp add: algebra_simps power_add)
moreover have "2*(2^(n+n) + (1-c)*2^n - c + 1/2) ≤ 2*(2^(n+n) + -0.5*1 - 1.5 + 1/2)"
by(auto simp add: algebra_simps two_realpow_ge_one c_def)
moreover hence "2*(2^(n+n) + (1-c)*2^n - c + 1/2) ≤ 2*(2^(n+n) - 1.5 )"
by(auto simp add: algebra_simps power_add)
ultimately have "cnt ( Node None deg treeList summary) ≤ 2*(2^(n+n) - 1.5 )" by simp
then show ?case using c_def 2(5) 2(6) by simp
next
case (3 treeList n summary m deg)
hence "∀t∈set treeList. (cnt t) ≤ 2 * (2 ^ n - c)" by simp
hence " foldr (λ a b. a+b) (map cnt treeList) 0 ≤ 2^(n+1)*2 * ((2^n - c)::real)"
using list_every_elemnt_bound_sum_bound_real[of treeList cnt "2*((2^n - c)::real)" 0 ] 3
by (auto simp add: algebra_simps)
moreover
hence "cnt ( Node None deg treeList summary) ≤ 2*(2^n*2^m - c* 2^(m) + 2^(m) - c + 1/2)"
using 3
by (auto simp add: algebra_simps powr_add)
moreover have "2*(2^n*2^m - c* 2^(m) + 2^(m) - c + 1/2) = 2*(2^(n+m) + (1-c)* 2^(m) - c + 1/2)"
by (auto simp add: algebra_simps power_add)
moreover have " 2*(2^(n+m) + (1-c)* 2^(m) - c + 1/2) ≤ 2*(2^(n+m) + -0.5*1 - 1.5 + 1/2)"
by(auto simp add: algebra_simps two_realpow_ge_one c_def)
moreover hence "2*(2^(n+m) + (1-c)*2^m - c + 1/2) ≤ 2*(2^(n+m) - 1.5 )"
by(auto simp add: algebra_simps power_add)
ultimately have "cnt ( Node None deg treeList summary) ≤ 2*(2^(n+m) - 1.5 )" by simp
then show ?case using c_def 3(5) 3(6) by simp
next
case (4 treeList n summary m deg mi ma)
hence "∀t∈set treeList. (cnt t) ≤ 2 * (2 ^ n - c)" by simp
hence " foldr (λ a b. a+b) (map cnt treeList) 0 ≤ 2^n*2 * ((2^n - c)::real)"
using list_every_elemnt_bound_sum_bound_real[of treeList cnt "2*((2^n - c)::real)" 0 ] 4
by (auto simp add: algebra_simps)
hence "cnt ( Node (Some (mi, ma)) deg treeList summary) ≤ 2*(2^n+1)*(2^n-c) + 1" using 4
by(auto simp add: algebra_simps)
hence "cnt ( Node None deg treeList summary) ≤ 2*(2^(n+n) + (1-c)*2^n - c + 1/2)"
by(auto simp add: algebra_simps power_add)
moreover have "2*(2^(n+n) + (1-c)*2^n - c + 1/2) ≤ 2*(2^(n+n) + -0.5*1 - 1.5 + 1/2)"
by(auto simp add: algebra_simps two_realpow_ge_one c_def)
moreover hence "2*(2^(n+n) + (1-c)*2^n - c + 1/2) ≤ 2*(2^(n+n) - 1.5 )"
by(auto simp add: algebra_simps power_add)
ultimately have "cnt ( Node None deg treeList summary) ≤ 2*(2^(n+n) - 1.5 )" by simp
then show ?case using c_def 4 by simp
next
case (5 treeList n summary m deg mi ma)
hence "∀t∈set treeList. (cnt t) ≤ 2 * (2 ^ n - c)" by simp
hence " foldr (λ a b. a+b) (map cnt treeList) 0 ≤ 2^(n+1)*2 * ((2^n - c)::real)"
using list_every_elemnt_bound_sum_bound_real[of treeList cnt "2*((2^n - c)::real)" 0 ] 5
by (auto simp add: algebra_simps)
moreover
hence "cnt ( Node (Some (mi, ma)) deg treeList summary) ≤ 2*(2^n*2^m - c* 2^(m) + 2^(m) - c + 1/2)"
using 5
by (auto simp add: algebra_simps powr_add)
moreover have "2*(2^n*2^m - c* 2^(m) + 2^(m) - c + 1/2) = 2*(2^(n+m) + (1-c)* 2^(m) - c + 1/2)"
by (auto simp add: algebra_simps power_add)
moreover have " 2*(2^(n+m) + (1-c)* 2^(m) - c + 1/2) ≤ 2*(2^(n+m) + -0.5*1 - 1.5 + 1/2)"
by(auto simp add: algebra_simps two_realpow_ge_one c_def)
moreover hence "2*(2^(n+m) + (1-c)*2^m - c + 1/2) ≤ 2*(2^(n+m) - 1.5 )"
by(auto simp add: algebra_simps power_add)
ultimately have "cnt ( Node None deg treeList summary) ≤ 2*(2^(n+m) - 1.5 )" by simp
then show ?case using c_def 5 by simp
qed (simp add: cnt.simps c_def)
theorem cnt_bound': "invar_vebt t n ⟹ cnt t ≤ 2 * (2 ^ n - 1)"
using cnt_bound by fastforce
lemma space_cnt: "space' t ≤ 6*cnt t"
proof(induction t)
case (Node info deg treeList summary)
hence " ∀t∈set treeList. space' t ≤ 6 * cnt t" by blast
hence " foldr (λ a b. a+b) (map space' treeList) 0 ≤
6 *foldr (λ a b. a+b) (map cnt treeList) 0"
using f_g_map_foldr_bound[of treeList space' 6 cnt 0]
by(auto simp add: algebra_simps real_nat_list)
then show ?case
using Node.IH(2) by force
qed simp
lemma space_2_pow_bound: assumes "invar_vebt t n " shows "real (space' t) ≤ 12 * (2^n -1)"
proof-
have "space' t ≤ 6 * cnt t"
using space_cnt[of t] assms by simp
moreover have "6 * cnt t ≤ 12 * (2^n -1)"
using cnt_bound'[of t n] assms by simp
ultimately show ?thesis by linarith
qed
lemma space'_bound: assumes "invar_vebt t n" "u = 2^n"
shows "space' t ≤ 12 * u"
using space_2_pow_bound[of t n]
proof -
have "real u - 1 = real (u - 1)"
by (simp add: assms(2) of_nat_diff)
then show ?thesis
using ‹invar_vebt t n ⟹ real (space' t) ≤ 12 * (2 ^ n - 1)› assms(1) assms(2) by auto
qed
text ‹Main Theorem›
theorem space_bound: assumes "invar_vebt t n" "u = 2^n"
shows "space t ≤ 12 * u"
by (metis assms(1) assms(2) dual_order.trans less_imp_le_nat space'_bound space_space')
subsection ‹Complexity of Generation Time ›
text ‹Space complexity is closely related to tree generation time complexity›
text ‹Time approximation for replicate function. $T_{replicate} \; n \; t \;x$ denotes runnig time of the $n$-times replication of $x$ into a list.
$t$ models runtime for generation of a single $x$.›
fun T⇩b⇩u⇩i⇩l⇩d⇩u⇩p::"nat ⇒ nat" where
"T⇩b⇩u⇩i⇩l⇩d⇩u⇩p 0 = 3"|
"T⇩b⇩u⇩i⇩l⇩d⇩u⇩p (Suc 0) = 3"|
"T⇩b⇩u⇩i⇩l⇩d⇩u⇩p n = (if even n then 1 + (let half = n div 2 in
9 + T⇩b⇩u⇩i⇩l⇩d⇩u⇩p half + (2^half) * (T⇩b⇩u⇩i⇩l⇩d⇩u⇩p half + 1))
else (let half = n div 2 in
11 + T⇩b⇩u⇩i⇩l⇩d⇩u⇩p (Suc half) + (2^(Suc half))* (T⇩b⇩u⇩i⇩l⇩d⇩u⇩p half + 1 )))"
fun T⇩b⇩u⇩i⇩l⇩d::"nat ⇒ nat" where
"T⇩b⇩u⇩i⇩l⇩d 0 = 4"|
"T⇩b⇩u⇩i⇩l⇩d (Suc 0) = 4"|
"T⇩b⇩u⇩i⇩l⇩d n = (if even n then 1 + (let half = n div 2 in
10 + T⇩b⇩u⇩i⇩l⇩d half + (2^half) * (T⇩b⇩u⇩i⇩l⇩d half))
else (let half = n div 2 in
12 + T⇩b⇩u⇩i⇩l⇩d (Suc half) + (2^(Suc half))* (T⇩b⇩u⇩i⇩l⇩d half)))"
lemma buildup_build_time: "T⇩b⇩u⇩i⇩l⇩d⇩u⇩p n < T⇩b⇩u⇩i⇩l⇩d n"
proof(induction n rule: T⇩b⇩u⇩i⇩l⇩d⇩u⇩p.induct)
case (3 va)
then show ?case
proof(cases "even (Suc (Suc va))")
case True
then show ?thesis
apply(subst T⇩b⇩u⇩i⇩l⇩d⇩u⇩p.simps)
apply(subst T⇩b⇩u⇩i⇩l⇩d.simps)
using True apply simp
by (smt (z3) "3.IH"(1) Suc_1 True add_mono_thms_linordered_semiring(1) distrib_left div2_Suc_Suc less_mult_imp_div_less linorder_not_le mult.commute mult_numeral_1_right nat_0_less_mult_iff nat_less_le nat_zero_less_power_iff nonzero_mult_div_cancel_left not_less_eq numerals(1) plus_1_eq_Suc zero_le_one)
next
case False
hence *: "(let half = Suc (Suc va) div 2
in 11 + T⇩b⇩u⇩i⇩l⇩d⇩u⇩p (Suc half) + 2 ^ Suc half * (T⇩b⇩u⇩i⇩l⇩d⇩u⇩p half + 1))
< (let half = Suc (Suc va) div 2
in 12 + T⇩b⇩u⇩i⇩l⇩d (Suc half) + 2 ^ Suc half * T⇩b⇩u⇩i⇩l⇩d half)"
unfolding Let_def
proof-
assume "odd (Suc (Suc va))"
have " 11 + T⇩b⇩u⇩i⇩l⇩d⇩u⇩p (Suc (Suc (Suc va) div 2))
< 12 + T⇩b⇩u⇩i⇩l⇩d (Suc (Suc (Suc va) div 2))"
using "3.IH"(3) False add_less_mono by presburger
moreover have " 2 ^ Suc (Suc (Suc va) div 2) * (T⇩b⇩u⇩i⇩l⇩d⇩u⇩p (Suc (Suc va) div 2) + 1)
≤ 2 ^ Suc (Suc (Suc va) div 2) * T⇩b⇩u⇩i⇩l⇩d (Suc (Suc va) div 2)"
by (metis "3.IH"(4) False Suc_leI add.commute mult_le_mono2 plus_1_eq_Suc)
ultimately show " 11 + T⇩b⇩u⇩i⇩l⇩d⇩u⇩p (Suc (Suc (Suc va) div 2)) +
2 ^ Suc (Suc (Suc va) div 2) * (T⇩b⇩u⇩i⇩l⇩d⇩u⇩p (Suc (Suc va) div 2) + 1)
< 12 + T⇩b⇩u⇩i⇩l⇩d (Suc (Suc (Suc va) div 2)) +
2 ^ Suc (Suc (Suc va) div 2) * T⇩b⇩u⇩i⇩l⇩d (Suc (Suc va) div 2)"
using add_mono_thms_linordered_field(3) by blast
qed
show ?thesis apply(subst T⇩b⇩u⇩i⇩l⇩d⇩u⇩p.simps)
apply(subst T⇩b⇩u⇩i⇩l⇩d.simps)
using False *
by simp
qed
qed simp+
lemma listsum_bound: "(⋀ x. x ∈ set xs ⟹ f x ≥ (0::real)) ⟹
foldr (+) (map f xs) y ≥ y"
apply(induction xs arbitrary: y)
apply simp
apply(subst list.map(2))
apply(subst foldr.simps)
apply (simp add: add_increasing)
done
lemma cnt_non_neg: "cnt t ≥ 0"
by (induction t) (simp add: VEBT_internal.listsum_bound)+
lemma foldr_same: "(⋀ x y. x ∈ set (xs::real list) ⟹ y ∈ set xs ⟹ x = y) ⟹
(⋀ x . (x::real) ∈ set xs ⟹ x = (y::real)) ⟹
foldr (λ (a::real) (b::real). a+b) xs 0 = real (length xs) * y"
apply(induction xs)
apply simp
apply(subst foldr.simps)
unfolding comp_def
proof -
fix a :: real and xsa :: "real list"
assume a1: "⟦⋀x y. ⟦x ∈ set xsa; y ∈ set xsa⟧ ⟹ x = y; ⋀x. x ∈ set xsa ⟹ x = y⟧ ⟹ foldr (+) xsa 0 = real (length xsa) * y"
assume "⋀x y. ⟦x ∈ set (a # xsa); y ∈ set (a # xsa)⟧ ⟹ x = y"
assume a2: "⋀x. x ∈ set (a # xsa) ⟹ x = y"
then have f3: "a = y"
by simp
then have "a * real (length xsa) = foldr (+) xsa 0"
using a2 a1 by (metis (no_types) list.set_intros(2) mult.commute)
then show "a + foldr (+) xsa 0 = real (length (a # xsa)) * y"
using f3 by (simp add: distrib_left mult.commute)
qed
lemma foldr_same_int: "(⋀ x y. x ∈ set xs ⟹ y ∈ set xs ⟹ x = y) ⟹
(⋀ x . x ∈ set xs ⟹ x = y) ⟹
foldr (+) xs 0 = (length xs) * y"
apply(induction xs)
apply simp
apply(subst foldr.simps)
apply fastforce
done
lemma t_build_cnt: "T⇩b⇩u⇩i⇩l⇩d n ≤ cnt (vebt_buildup n) * 13"
proof(induction n rule: T⇩b⇩u⇩i⇩l⇩d.induct)
case 1
then show ?case by simp
next
case 2
then show ?case by simp
next
case (3 va)
then show ?case
proof(cases "even (Suc (Suc va))")
case True
hence *: "T⇩b⇩u⇩i⇩l⇩d (Suc (Suc va)) = 11+
T⇩b⇩u⇩i⇩l⇩d (Suc (Suc va) div 2) +
2 ^ (Suc (Suc va) div 2) * (T⇩b⇩u⇩i⇩l⇩d (Suc (Suc va) div 2))"
apply(subst T⇩b⇩u⇩i⇩l⇩d.simps)
by simp
have " real (T⇩b⇩u⇩i⇩l⇩d (Suc (va div 2))) ≤ 13 * cnt (vebt_buildup (Suc (va div 2)))"
using "3.IH"(1) True by force
moreover hence 1:" 2 ^ (Suc (Suc va) div 2)* (T⇩b⇩u⇩i⇩l⇩d (Suc (Suc va) div 2)) ≤
2 ^ (Suc (Suc va) div 2) * ((cnt (vebt_buildup (Suc (Suc va) div 2)))*13)"
using ordered_semiring_class.mult_mono[of "(T⇩b⇩u⇩i⇩l⇩d (Suc (Suc va) div 2))" " ((cnt (vebt_buildup (Suc (Suc va) div 2)))*13)"
"2 ^ (Suc (Suc va) div 2)" "2 ^ (Suc (Suc va) div 2)"] by simp
ultimately have " T⇩b⇩u⇩i⇩l⇩d (Suc (Suc va) div 2) +
2 ^ (Suc (Suc va) div 2) * (T⇩b⇩u⇩i⇩l⇩d (Suc (Suc va) div 2)) ≤
cnt (vebt_buildup (Suc (Suc va) div 2))*13 +
2 ^ (Suc (Suc va) div 2) * ((cnt (vebt_buildup (Suc (Suc va) div 2)))*13)"
by (smt (verit) "3.IH"(1) True of_nat_add)
have 10: "(foldr (+)
(replicate (l) ((cnt (vebt_buildup (Suc (Suc va) div 2)))
)) 0) =
l * ((cnt (vebt_buildup (Suc (Suc va) div 2))))" for l
using foldr_same[of "(replicate l (cnt (vebt_buildup (Suc (Suc va) div 2))))"
"cnt (vebt_buildup (Suc (Suc va) div 2))" ]
length_replicate by simp
have " cnt (vebt_buildup (Suc (Suc va) div 2))*13 +
2 ^ (Suc (Suc va) div 2) * ((cnt (vebt_buildup (Suc (Suc va) div 2)))*13) + 11≤
13* cnt (vebt_buildup (Suc (Suc va)))"
apply(subst vebt_buildup.simps)
using True apply simp
apply(subst sym[OF foldr_replicate])
proof-
assume "even va"
have " 2* (2 ^ (va div 2) * cnt (vebt_buildup (Suc (va div 2)))) =
foldr (+) (replicate (2 * 2 ^ (va div 2)) (cnt (vebt_buildup (Suc (va div 2))))) 0"
apply(rule sym)
using 10 div2_Suc_Suc[of va] by simp
then show "26 * (2 ^ (va div 2) * cnt (vebt_buildup (Suc (va div 2))))
≤ 2 + 13 * foldr (+) (replicate (2 * 2 ^ (va div 2)) (cnt (vebt_buildup (Suc (va div 2))))) 0"
by simp
qed
then show ?thesis
by (smt (verit, ccfv_SIG) "*" "1" "3.IH"(1) True numeral_Bit1 numeral_plus_numeral numeral_plus_one of_nat_add of_nat_numeral semiring_norm(2))
next
case False
have "12 + T⇩b⇩u⇩i⇩l⇩d (Suc ( Suc (va div 2))) + 2 ^ Suc ( Suc ( va div 2)) * T⇩b⇩u⇩i⇩l⇩d ( Suc ( va div 2))
≤ cnt ( Node None (Suc (Suc va)) (replicate (2 ^ Suc ( Suc ( va div 2))) (vebt_buildup ( Suc ( va div 2))))
(vebt_buildup (Suc ( Suc ( va div 2))))) * 13"
apply(subst cnt.simps)
proof-
have 10: "(foldr (+)
(replicate (l) ((cnt (vebt_buildup (Suc (Suc va) div 2)))
)) 0) =
l * ((cnt (vebt_buildup (Suc (Suc va) div 2))))" for l
using foldr_same[of "(replicate l (cnt (vebt_buildup (Suc (Suc va) div 2))))"
"cnt (vebt_buildup (Suc (Suc va) div 2))" ]
length_replicate by simp
hence map_cnt: " foldr (+) (map cnt (replicate (2 ^ Suc (Suc (va div 2))) (vebt_buildup (Suc (va div 2))))) 0 =
2 ^ Suc (Suc (va div 2)) * cnt (vebt_buildup (Suc (va div 2))) " by simp
have "T⇩b⇩u⇩i⇩l⇩d (Suc (Suc (va div 2))) ≤ 13 * cnt (vebt_buildup (Suc (Suc (va div 2))))"
using "3.IH"(3) False by force
moreover have "T⇩b⇩u⇩i⇩l⇩d (Suc (va div 2)) ≤ 13 * cnt(vebt_buildup (Suc (va div 2)))"
using "3.IH"(4) False by force
moreover have add_double_trans: "(a::real) ≤ b ⟹ c ≤ d ⟹
i ≥ 0⟹ a + c*i ≤ b + d*i" for a b c d i
using mult_right_mono by fastforce
ultimately have " real(T⇩b⇩u⇩i⇩l⇩d (Suc (Suc (va div 2)))) + 2 ^ Suc (Suc (va div 2)) * real( T⇩b⇩u⇩i⇩l⇩d (Suc (va div 2))) ≤
13 * cnt (vebt_buildup (Suc (Suc (va div 2)))) +
2 ^ Suc (Suc (va div 2)) * (13 * cnt(vebt_buildup (Suc (va div 2))))"
by (meson add_mono_thms_linordered_semiring(1) mult_mono of_nat_0_le_iff order_refl zero_le_numeral zero_le_power)
hence 11:"(12 + T⇩b⇩u⇩i⇩l⇩d (Suc (Suc (va div 2))) + 2 ^ Suc (Suc (va div 2)) * T⇩b⇩u⇩i⇩l⇩d (Suc (va div 2))) ≤
12 + 13 * cnt (vebt_buildup (Suc (Suc (va div 2)))) +
2 ^ Suc (Suc (va div 2)) * 13 * cnt(vebt_buildup (Suc (va div 2)))"
using algebra_simps by simp
show " (12 + T⇩b⇩u⇩i⇩l⇩d (Suc (Suc (va div 2))) +
2 ^ Suc (Suc (va div 2)) * T⇩b⇩u⇩i⇩l⇩d (Suc (va div 2)))
≤ (1 + cnt (vebt_buildup (Suc (Suc (va div 2)))) +
foldr (+) (map cnt (replicate (2 ^ Suc (Suc (va div 2))) (vebt_buildup (Suc (va div 2))))) 0) * 13"
apply(subst map_cnt)
using 11 algebra_simps by simp
qed
then show ?thesis
apply(subst vebt_buildup.simps)
apply(subst T⇩b⇩u⇩i⇩l⇩d.simps)
using False by force
qed
qed
lemma t_buildup_cnt: "T⇩b⇩u⇩i⇩l⇩d⇩u⇩p n ≤ cnt (vebt_buildup n) * 13"
apply(rule order.trans[where b = "real(T⇩b⇩u⇩i⇩l⇩d n)"])
apply(rule order.strict_implies_order)
apply (simp add: VEBT_internal.buildup_build_time)
apply(rule t_build_cnt)
done
lemma count_buildup: "cnt (vebt_buildup n) ≤ 2 * 2^n"
by (smt (verit, ccfv_threshold) VEBT_internal.cnt_bound' add.right_neutral add_less_mono buildup_gives_valid cnt.simps(1) even_Suc lessI odd_pos one_le_power plus_1_eq_Suc vebt_buildup.elims)
lemma count_buildup': "cnt (vebt_buildup n) ≤ 2 * (2::nat)^n"
by (simp add: VEBT_internal.count_buildup)
theorem vebt_buildup_bound: "u = 2^n ⟹ T⇩b⇩u⇩i⇩l⇩d⇩u⇩p n ≤ 26 * u"
using count_buildup'[of n] t_buildup_cnt[of n] by linarith
text ‹Count in natural numbers›
fun cnt':: "VEBT ⇒ nat" where
"cnt' (Leaf a b) = 1"|
"cnt' (Node info deg treeList summary) = 1 + cnt' summary + foldr (λ a b. a+b) (map cnt' treeList) 0"
lemma cnt_cnt_eq:"cnt t = cnt' t"
apply(induction t)
apply auto
apply (smt (z3) VEBT_internal.real_nat_list map_eq_conv of_nat_0)
done
end
end
Theory VEBT_Intf_Functional
section ‹Functional Interface›
theory VEBT_Intf_Functional
imports Main
VEBT_Definitions VEBT_Space
VEBT_Uniqueness
VEBT_Member
VEBT_Insert VEBT_InsertCorrectness
VEBT_MinMax
VEBT_Pred VEBT_Succ
VEBT_Bounds
VEBT_Delete VEBT_DeleteCorrectness VEBT_DeleteBounds
begin
subsection ‹Code Generation Setup›
subsubsection ‹Code Equations›
text ‹Code generator seems to not support patterns and nat code target›
context begin
interpretation VEBT_internal .
lemma vebt_member_code[code]:
"vebt_member (Leaf a b) x = (if x = 0 then a else if x=1 then b else False)"
"vebt_member (Node None t r e) x = False"
"vebt_member (Node (Some (mi, ma)) deg treeList summary) x =
(if deg = 0 ∨ deg = Suc 0 then False else (
if x = mi then True else
if x = ma then True else
if x < mi then False else
if x > ma then False else
(let
h = high x (deg div 2);
l = low x (deg div 2) in
(if h < length treeList
then vebt_member (treeList ! h) l
else False))))"
apply simp
apply simp
proof(goal_cases)
case 1
consider "deg = 0"| "deg = Suc 0"
| n where "deg = Suc (Suc n)"
by (meson vebt_buildup.cases)
then show ?case apply(cases)
by simp_all
qed
lemma vebt_insert_code[code]:
"vebt_insert (Leaf a b) x = (if x=0 then Leaf True b else if x=1 then Leaf a True else Leaf a b)"
"vebt_insert (Node info deg treeList summary) x = (
if deg ≤ 1 then
(Node info deg treeList summary)
else ( case info of
None ⇒ (Node (Some (x,x)) deg treeList summary)
| Some mima ⇒ ( case mima of (mi, ma) ⇒ (
let
xn = (if x < mi then mi else x);
minn = (if x< mi then x else mi);
l= low xn (deg div 2); h = high xn (deg div 2)
in (
if h < length treeList ∧ ¬ (x = mi ∨ x = ma) then
Node (Some (minn, max xn ma))
deg
(treeList[h:= vebt_insert (treeList ! h) l])
(if minNull (treeList ! h) then vebt_insert summary h else summary)
else Node (Some (mi, ma)) deg treeList summary)
))))"
apply simp
apply simp
proof(goal_cases)
case 1
consider "deg = 0"| "deg = Suc 0"
| n where "deg = Suc (Suc n)"
by (meson vebt_buildup.cases)
then show ?case apply(cases)
apply simp+
apply(cases info)
apply simp+
apply(cases "the info")
apply simp
by meson
qed
lemma vebt_succ_code[code]:
"vebt_succ (Leaf a b) x = (if b∧ x = 0 then Some 1 else None)"
"vebt_succ (Node info deg treeList summary) x = (if deg ≤ 1 then None else
(case info of None ⇒ None |
(Some mima) ⇒ (case mima of (mi, ma) ⇒ (
if x < mi then (Some mi)
else (let l = low x (deg div 2); h = high x (deg div 2) in(
if h < length treeList then
let maxlow = vebt_maxt (treeList ! h) in
(if maxlow ≠ None ∧ (Some l <⇩o maxlow) then
Some (2^(deg div 2)) *⇩o Some h +⇩o vebt_succ (treeList ! h) l
else let sc = vebt_succ summary h in
if sc = None then None
else Some (2^(deg div 2)) *⇩o sc +⇩o vebt_mint (treeList ! the sc) )
else None))))))"
apply (cases "(Leaf a b,x)" rule: vebt_succ.cases; simp)
apply (cases "(Node info deg treeList summary,x)" rule: vebt_succ.cases; simp add: Let_def)
done
lemma vebt_pred_code[code]:
"vebt_pred (Leaf a b) x = (if x = 0 then None else if x = 1 then
(if a then Some 0 else None) else
(if b then Some 1 else if a then Some 0 else None))" and
"vebt_pred (Node info deg treeList summary) x =(if deg ≤ 1 then None else (
case info of None ⇒ None |
(Some mima) ⇒ (case mima of (mi, ma) ⇒ (
if x > ma then Some ma
else (let l = low x (deg div 2); h = high x (deg div 2) in
if h < length treeList then
let minlow = vebt_mint (treeList ! h) in
(if minlow ≠ None ∧ (Some l >⇩o minlow) then
Some (2^(deg div 2)) *⇩o Some h +⇩o vebt_pred (treeList ! h) l
else let pr = vebt_pred summary h in
if pr = None then (if x > mi then Some mi else None)
else Some (2^(deg div 2)) *⇩o pr +⇩o vebt_maxt (treeList ! the pr) )
else None)))))"
apply (cases "(Leaf a b,x)" rule: vebt_pred.cases; simp)
apply (cases "(Node info deg treeList summary,x)" rule: vebt_pred.cases; simp add: Let_def)
done
lemma vebt_delete_code[code]:
"vebt_delete (Leaf a b) x = (if x = 0 then Leaf False b else if x = 1 then Leaf a False else Leaf a b)"
"vebt_delete (Node info deg treeList summary) x = (
case info of
None ⇒ (Node info deg treeList summary)
| Some mima ⇒ (
if deg ≤ 1 then (Node info deg treeList summary)
else (case mima of (mi, ma) ⇒ (
if (x < mi ∨ x > ma) then (Node (Some (mi, ma)) deg treeList summary)
else if (x = mi ∧ x = ma) then (Node None deg treeList summary)
else let
xn = (if x = mi then the (vebt_mint summary) * 2^(deg div 2)
+ the (vebt_mint (treeList ! the (vebt_mint summary)))
else x);
minn = (if x = mi then xn else mi);
l = low xn (deg div 2);
h = high xn (deg div 2)
in
if h < length treeList then let
newnode = vebt_delete (treeList ! h) l;
newlist = treeList[h:= newnode]
in
if minNull newnode then let
sn = vebt_delete summary h;
maxn =
if xn = ma then let
maxs = vebt_maxt sn
in
if maxs = None then minn
else 2^(deg div 2) * the maxs + the (vebt_maxt (newlist ! the maxs))
else ma
in (Node (Some (minn, maxn)) deg newlist sn)
else let
maxn = (if xn = ma then h * 2^(deg div 2) + the( vebt_maxt (newlist ! h))
else ma)
in (Node (Some (minn, maxn)) deg newlist summary)
else (Node (Some (mi, ma)) deg treeList summary)
))))"
apply (cases "(Leaf a b,x)" rule: vebt_delete.cases; simp)
apply (cases "(Node info deg treeList summary,x)" rule: vebt_delete.cases; simp add: Let_def)
done
end
lemmas [code] =
VEBT_internal.high_def VEBT_internal.low_def VEBT_internal.minNull.simps
VEBT_internal.less.simps VEBT_internal.mul_def VEBT_internal.add_def
VEBT_internal.option_comp_shift.simps VEBT_internal.option_shift.simps
export_code
vebt_buildup
vebt_insert
vebt_member
vebt_maxt
vebt_mint
vebt_pred
vebt_succ
vebt_delete
checking SML
subsection ‹Correctness Lemmas›
named_theorems vebt_simps ‹Simplifier rules for VEBT functional interface›
locale vebt_inst =
fixes n :: nat
begin
interpretation VEBT_internal .
subsubsection ‹Space Bound›
theorem vebt_space_linear_bound:
fixes t
defines "u ≡ 2^n"
shows "invar_vebt t n ⟹ space t ≤ 12*u"
by (simp add: space_bound u_def)
subsubsection ‹Buildup›
lemma invar_vebt_buildup[vebt_simps]: "invar_vebt (vebt_buildup n) n ⟷ n>0"
by (auto simp add: buildup_gives_valid deg_not_0)
lemma set_vebt_buildup[vebt_simps]: "set_vebt (vebt_buildup i) = {}"
by (metis VEBT_internal.buildup_gives_empty VEBT_internal.buildup_gives_valid VEBT_internal.set_vebt_set_vebt'_valid neq0_conv invar_vebt.intros(1) vebt_buildup.simps(1))
lemma time_vebt_buildup: "u = 2^n ⟹ T⇩b⇩u⇩i⇩l⇩d⇩u⇩p n ≤ 26 * u"
using vebt_buildup_bound by simp
subsubsection ‹Equality›
lemma set_vebt_equal[vebt_simps]: "invar_vebt t⇩1 n ⟹ invar_vebt t⇩2 n ⟹ t⇩1=t⇩2 ⟷ set_vebt t⇩1 = set_vebt t⇩2"
by (auto simp: unique_tree)
subsubsection ‹Member›
lemma set_vebt_member[vebt_simps]: "invar_vebt t n ⟹ vebt_member t x ⟷ x∈set_vebt t"
by (rule member_correct)
theorem time_vebt_member: "invar_vebt t n ⟹ u = 2^n ⟹ T⇩m⇩e⇩m⇩b⇩e⇩r t x ≤ 30 + 15 * lb (lb u)"
using member_bound_size_univ by auto
subsubsection ‹Insert›
theorem invar_vebt_insert[vebt_simps]: "invar_vebt t n ⟹ x< 2^n ⟹ invar_vebt (vebt_insert t x) n"
by (simp add: valid_pres_insert)
theorem set_vebt_insert[vebt_simps]: "invar_vebt t n ⟹ x < 2^n ⟹ set_vebt (vebt_insert t x) = set_vebt t ∪ {x}"
by (meson insert_correct[symmetric])
theorem time_vebt_insert: "invar_vebt t n ⟹ u = 2^n ⟹ T⇩i⇩n⇩s⇩e⇩r⇩t t x ≤ 46 + 23 * lb (lb u)"
by (meson insert_bound_size_univ)
subsubsection ‹Maximum›
theorem set_vebt_maxt: "invar_vebt t n ⟹ vebt_maxt t = Some x ⟷ max_in_set (set_vebt t) x"
by (metis maxt_sound maxt_corr set_vebt_set_vebt'_valid)
theorem set_vebt_maxt': "invar_vebt t n ⟹ vebt_maxt t = Some x ⟷ (x∈set_vebt t ∧ (∀y∈set_vebt t. x≥y))"
using set_vebt_maxt unfolding max_in_set_def by blast
lemma set_vebt_maxt''[vebt_simps]:
"invar_vebt t n ⟹ vebt_maxt t = (if set_vebt t = {} then None else Some (Max (set_vebt t)))"
by (metis Max_ge Max_in VEBT_internal.set_vebt_finite VEBT_internal.set_vebt_set_vebt'_valid empty_iff option.exhaust set_vebt_maxt')
lemma time_vebt_maxt: "T⇩m⇩a⇩x⇩t t ≤ 3"
by (simp add: maxt_bound)
subsubsection ‹Minimum›
theorem set_vebt_mint[vebt_simps]: "invar_vebt t n ⟹ vebt_mint t = Some x ⟷ min_in_set (set_vebt t) x"
by (metis VEBT_internal.mint_corr VEBT_internal.mint_sound VEBT_internal.set_vebt_set_vebt'_valid)
theorem set_vebt_mint': "invar_vebt t n ⟹ vebt_mint t = Some x ⟷ (x∈set_vebt t ∧ (∀y∈set_vebt t. x≤y))"
using set_vebt_mint unfolding min_in_set_def by blast
lemma set_vebt_mint''[vebt_simps]:
"invar_vebt t n ⟹ vebt_mint t = (if set_vebt t = {} then None else Some (Min (set_vebt t)))"
by (metis Min_in Min_le VEBT_internal.set_vebt_finite VEBT_internal.set_vebt_set_vebt'_valid empty_iff option.exhaust set_vebt_mint')
lemma time_vebt_mint: "T⇩m⇩i⇩n⇩t t ≤ 3"
by (simp add: mint_bound)
subsection ‹Emptiness determination›
text ‹ A tree is empty if and only if its minimum is None›
lemma vebt_minNull_mint: " minNull t ⟷ vebt_mint t = None"
by (meson VEBT_internal.minNullmin VEBT_internal.minminNull)
lemma set_vebt_minNull: "invar_vebt t n ⟹ minNull t ⟷ set_vebt t = {}"
by (metis VEBT_internal.minNullmin VEBT_internal.minminNull VEBT_internal.mint_corr_help_empty VEBT_internal.set_vebt_set_vebt'_valid vebt_inst.set_vebt_mint'')
lemma time_vebt_minNull: "T⇩m⇩i⇩n⇩N⇩u⇩l⇩l t ≤ 1"
using minNull_bound by auto
subsubsection ‹Successor›
theorem set_vebt_succ: "invar_vebt t n ⟹ vebt_succ t x = Some sx ⟷ is_succ_in_set (set_vebt t) x sx"
by (simp add: succ_corr set_vebt_set_vebt'_valid)
lemma set_vebt_succ'[vebt_simps]: "invar_vebt t n ⟹ vebt_succ t x = (if ∃ y ∈ set_vebt t. y > x then Some (LEAST y ∈ set_vebt t. y > x) else None)"
apply (clarsimp;safe)
subgoal
apply(clarsimp simp add: succ_correct is_succ_in_set_def Least_le)
by (metis (no_types, lifting) LeastI_ex)
subgoal by (meson succ_correct is_succ_in_set_def option.exhaust_sel)
done
theorem time_vebt_succ:
fixes t defines "u ≡ 2^n"
shows "invar_vebt t n ⟹ T⇩s⇩u⇩c⇩c t x ≤ 54 + 27 * lb (lb u)"
using succ_bound_size_univ unfolding u_def by presburger
subsubsection ‹Predecessor›
theorem set_vebt_pred: "invar_vebt t n ⟹ vebt_pred t x = Some px ⟷ is_pred_in_set (set_vebt t) x px"
by (simp add: pred_corr set_vebt_set_vebt'_valid)
theorem set_vebt_pred'[vebt_simps]: "invar_vebt t n ⟹
vebt_pred t x = (if ∃ y ∈ set_vebt t. y < x then Some (GREATEST y. y ∈ set_vebt t ∧ y < x) else None)"
apply (clarsimp simp: member_correct pred_empty pred_correct is_pred_in_set_def)
by (metis (no_types, lifting) GreatestI_nat Greatest_le_nat less_imp_le)
theorem time_vebt_pred: fixes t defines "u ≡ 2^n"
shows "invar_vebt t n ⟹ T⇩p⇩r⇩e⇩d t x ≤ 58 + 29 * lb (lb u)"
unfolding u_def by (meson pred_bound_size_univ)
subsubsection ‹Delete›
theorem invar_vebt_delete[vebt_simps]: "invar_vebt t n ⟹ invar_vebt (vebt_delete t x) n"
by (simp add: delete_pres_valid)
theorem set_vebt_delete[vebt_simps]: "invar_vebt t n ⟹ set_vebt (vebt_delete t x) = set_vebt t - {x}"
by (metis delete_correct invar_vebt_delete set_vebt_set_vebt'_valid)
theorem time_vebt_delete: fixes t defines "u ≡ 2^n"
shows "invar_vebt t n ⟹ T⇩d⇩e⇩l⇩e⇩t⇩e t x ≤ 140 + 70 * lb (lb u)"
unfolding u_def by (meson delete_bound_size_univ)
end
subsection ‹Interface Usage Example›
experiment
begin
definition "test n xs ys ≡ let
t = vebt_buildup n;
t = foldl vebt_insert t (0#xs);
f = (λx. if vebt_member t x then x else the (vebt_pred t x))
in
map f ys"
context fixes n :: nat begin
interpretation vebt_inst n .
lemmas [simp] = vebt_simps
lemma [simp]:
assumes "invar_vebt t n" "∀x∈set xs. x<2^n"
shows "invar_vebt (foldl vebt_insert t xs) n"
using assms apply (induction xs arbitrary: t)
by auto
lemma [simp]:
assumes "invar_vebt t n" "∀x∈set xs. x<2^n"
shows "set_vebt (foldl vebt_insert t xs) = set_vebt t ∪ set xs"
using assms
apply (induction xs arbitrary: t)
apply auto
done
lemma "⟦∀x∈set xs. x<2^n; n>0⟧ ⟹ test n xs ys = map (λy. (GREATEST y'. y'∈insert 0 (set xs) ∧ y'≤y)) ys"
unfolding test_def
apply (auto simp add: Let_def)
subgoal by (metis (mono_tags, lifting) Greatest_equality le_zero_eq)
subgoal by (metis (no_types, lifting) Greatest_equality order_refl)
subgoal by (metis less_le)
done
end
end
end
Theory VEBT_List_Assn
theory VEBT_List_Assn
imports
"Separation_Logic_Imperative_HOL/Sep_Main"
"HOL-Library.Rewrite"
begin
subsection "Lists"
fun list_assn :: "('a ⇒ 'c ⇒ assn) ⇒ 'a list ⇒ 'c list ⇒ assn" where
"list_assn P [] [] = emp"
| "list_assn P (a#as) (c#cs) = P a c * list_assn P as cs"
| "list_assn _ _ _ = false"
lemma list_assn_aux_simps[simp]:
"list_assn P [] l' = (↑(l'=[]))"
"list_assn P l [] = (↑(l=[]))"
apply (cases l')
apply simp
apply simp
apply (cases l)
apply simp
apply simp
done
lemma list_assn_aux_append[simp]:
"length l1=length l1' ⟹
list_assn P (l1@l2) (l1'@l2')
= list_assn P l1 l1' * list_assn P l2 l2'"
apply (induct rule: list_induct2)
apply simp
apply (simp add: star_assoc)
done
lemma list_assn_aux_ineq_len: "length l ≠ length li ⟹ list_assn A l li = false"
proof (induction l arbitrary: li)
case (Cons x l li) thus ?case by (cases li; auto)
qed simp
lemma list_assn_aux_append2[simp]:
assumes "length l2=length l2'"
shows "list_assn P (l1@l2) (l1'@l2')
= list_assn P l1 l1' * list_assn P l2 l2'"
apply (cases "length l1 = length l1'")
apply (erule list_assn_aux_append)
apply (simp add: list_assn_aux_ineq_len assms)
done
lemma list_assn_simps[simp]:
"(list_assn P) [] [] = emp"
"(list_assn P) (a#as) (c#cs) = P a c * (list_assn P) as cs"
"(list_assn P) (a#as) [] = false"
"(list_assn P) [] (c#cs) = false"
apply simp_all
done
lemma list_assn_mono:
"⟦⋀x x'. P x x'⟹⇩AP' x x'⟧ ⟹ list_assn P l l' ⟹⇩A list_assn P' l l'"
apply (induct P l l' rule: list_assn.induct)
by (auto intro: ent_star_mono)
lemma list_assn_cong[fundef_cong]:
assumes "xs=xs'" "xsi=xsi'"
assumes "⋀x xi. x∈set xs' ⟹ xi∈set xsi' ⟹ A x xi = A' x xi"
shows "list_assn A xs xsi = list_assn A' xs' xsi'"
using assms
apply (induct A≡A xs' xsi' arbitrary: xs xsi rule: list_assn.induct)
apply simp_all
done
term prod_list
definition "listI_assn I A xs xsi ≡
↑(length xsi=length xs ∧ I⊆{0..<length xs})
* Finite_Set.fold (λi a. a * A (xs!i) (xsi!i)) 1 I"
lemma aux: "Finite_Set.fold (λi aa. aa * P ((a # as) ! i) ((c # cs) ! i)) emp {0..<Suc (length as)}
= P a c * Finite_Set.fold (λi aa. aa * P (as ! i) (cs ! i)) emp {0..<length as}"
proof -
have 1: "{0..<Suc (length as)} = insert 0 {1..<Suc (length as)}" by auto
have 2: "{Suc 0..<Suc (Suc n)} = insert (Suc n) {Suc 0 ..< Suc n}" for n by auto
have 3: "{0..<Suc n} = insert n {0..<n}" for n by auto
have A: "
Finite_Set.fold P emp {Suc 0..<Suc n}
= Finite_Set.fold Q emp {0..<n}"
if "∀i x. P (Suc i) x = Q i x"
and "comp_fun_commute P"
and "comp_fun_commute Q"
for P Q n
using that
apply (induction n arbitrary: a)
subgoal by simp
apply (simp add: comp_fun_commute.fold_insert)
apply (subst 2)
apply (subst 3)
apply (simp add: comp_fun_commute.fold_insert)
done
show ?thesis
apply (simp add: 1)
apply (subst comp_fun_commute.fold_insert_remove)
subgoal
apply unfold_locales
apply (auto simp: fun_eq_iff algebra_simps)
done
subgoal by simp
apply simp
apply (rewrite at "⌑ = _*_" mult.commute)
apply (rule arg_cong[where f="λx. P _ _ * x"])
apply (rule A)
subgoal by auto
subgoal
apply unfold_locales
apply (auto simp: fun_eq_iff algebra_simps)
done
subgoal
apply unfold_locales
apply (auto simp: fun_eq_iff algebra_simps)
done
done
qed
lemma list_assn_conv_idx: "list_assn A xs xsi = listI_assn {0..<length xs} A xs xsi"
apply (induction A xs xsi rule: list_assn.induct)
apply (auto simp: listI_assn_def aux)
done
lemma listI_assn_conv: "n=length xs ⟹ listI_assn {0..<n} A xs xsi = list_assn A xs xsi"
by (simp add: list_assn_conv_idx)
lemma listI_assn_conv': "n=length xs ⟹ listI_assn {0..<n} A xs xsi *F = list_assn A xs xsi* F"
by (simp add: list_assn_conv_idx)
lemma listI_assn_finite[simp]: "¬finite I ⟹ listI_assn I A xs xsi = false"
using subset_eq_atLeast0_lessThan_finite by (auto simp: listI_assn_def)
find_theorems Finite_Set.fold name: cong
lemma mult_fun_commute: "comp_fun_commute (λi (a::assn). a * f i)"
apply unfold_locales
apply (auto simp: fun_eq_iff mult_ac)
done
lemma listI_assn_weak_cong:
assumes I: "I=I'" "A=A'" "length xs=length xs'" "length xsi=length xsi'"
assumes A: "⋀i. ⟦i∈I; i<length xs; length xs=length xsi ⟧
⟹ xs!i = xs'!i ∧ xsi!i = xsi'!i"
shows "listI_assn I A xs xsi = listI_assn I' A' xs' xsi'"
unfolding listI_assn_def
apply (simp add: I)
apply (cases "length xsi' = length xs' ∧ I' ⊆ {0..<length xs'}"; simp only:; simp)
apply (rule Finite_Set.fold_cong)
apply (simp_all add: mult_fun_commute)
subgoal by (meson subset_eq_atLeast0_lessThan_finite)
subgoal using A by (auto simp: fun_eq_iff I)
done
lemma listI_assn_cong:
assumes I: "I=I'" "length xs=length xs'" "length xsi=length xsi'"
assumes A: "⋀i. ⟦i∈I; i<length xs; length xs=length xsi ⟧
⟹ xs!i = xs'!i ∧ xsi!i = xsi'!i
∧ A (xs!i) (xsi!i) = A' (xs'!i) (xsi'!i)"
shows "listI_assn I A xs xsi = listI_assn I' A' xs' xsi'"
unfolding listI_assn_def
apply (simp add: I)
apply (cases "length xsi' = length xs' ∧ I' ⊆ {0..<length xs'}"; simp only:; simp)
apply (rule Finite_Set.fold_cong)
apply (simp_all add: mult_fun_commute)
subgoal by (meson subset_eq_atLeast0_lessThan_finite)
subgoal using A by (fastforce simp: fun_eq_iff I)
done
lemma listI_assn_insert: "i∉I ⟹ i<length xs ⟹
listI_assn (insert i I) A xs xsi = A (xs!i) (xsi!i) * listI_assn I A xs xsi"
apply (cases "finite I"; simp?)
unfolding listI_assn_def
apply (subst comp_fun_commute.fold_insert)
subgoal
apply unfold_locales
apply (auto simp: fun_eq_iff algebra_simps)
done
subgoal by simp
subgoal by simp
subgoal by (auto simp: algebra_simps)
done
listI_assn_extract:
assumes "i∈I" "i<length xs"
shows "listI_assn I A xs xsi = A (xs!i) (xsi!i) * listI_assn (I-{i}) A xs xsi"
proof -
have 1: "I = insert i (I-{i})" using assms by auto
show ?thesis
apply (subst 1)
apply (subst listI_assn_insert)
using assms by auto
qed
lemma listI_assn_reinsert:
assumes "P ⟹⇩A A (xs!i) (xsi!i) * listI_assn (I-{i}) A xs xsi * F"
assumes "i<length xs" "i∈I"
assumes "listI_assn I A xs xsi * F ⟹⇩A Q"
shows "P ⟹⇩A Q"
proof -
show ?thesis
apply (rule ent_trans[OF assms(1)])
apply (subst listI_assn_extract[symmetric])
subgoal by fact
subgoal by fact
subgoal by fact
done
qed
lemma listI_assn_reinsert_upd:
fixes xs xsi :: "_ list"
assumes "P ⟹⇩A A x xi * listI_assn (I-{i}) A xs xsi * F"
assumes "i<length xs" "i∈I"
assumes "listI_assn I A (xs[i:=x]) (xsi[i:=xi]) * F ⟹⇩A Q"
shows "P ⟹⇩A Q"
proof (cases "length xs = length xsi")
case True
have 1: "listI_assn (I-{i}) A xs xsi = listI_assn (I-{i}) A (xs[i:=x]) (xsi[i:=xi])"
by (rule listI_assn_cong) auto
have 2: "A x xi = A ((xs[i:=x])!i) ((xsi[i:=xi])!i)" using ‹i<length xs› True by auto
from assms[unfolded 1 2] show ?thesis
apply (rule_tac listI_assn_reinsert)
apply assumption
apply simp_all
done
next
case False
with assms(1) have "P ⟹⇩A false"
by (simp add: listI_assn_def)
thus ?thesis using ent_false_iff entailsI by blast
qed
lemma listI_assn_reinsert':
assumes "P ⟹⇩A A (xs!i) (xsi!i) * listI_assn (I-{i}) A xs xsi * F"
assumes "i<length xs" "i∈I"
assumes "<listI_assn I A xs xsi * F>c<Q>"
shows "<P>c<Q>"
proof -
show ?thesis
apply (rule cons_pre_rule[OF assms(1)])
apply (subst listI_assn_extract[symmetric])
subgoal by fact
subgoal by fact
subgoal by fact
done
qed
lemma listI_assn_reinsert_upd':
fixes xs xsi :: "_ list"
assumes "P ⟹⇩A A x xi * listI_assn (I-{i}) A xs xsi * F"
assumes "i<length xs" "i∈I"
assumes "<listI_assn I A (xs[i:=x]) (xsi[i:=xi]) * F> c <Q>"
shows "<P> c <Q>"
by (meson assms(1) assms(2) assms(3) assms(4) cons_pre_rule ent_refl listI_assn_reinsert_upd)
lemma subst_not_in:
assumes "i∉I " " i<length xs "
shows "listI_assn I A (xs[i:=x1]) (xsi[i := x2]) = listI_assn I A xs xsi"
apply (rule listI_assn_cong)
using assms
by (auto simp add: nth_list_update')
lemma listI_assn_subst:
assumes "i∉I "" i<length xs "
shows "listI_assn (insert i I) A (xs[i:=x1]) (xsi[i := x2]) = A x1 x2 * listI_assn I A xs xsi"
by (smt (z3) assms(1) assms(2) length_list_update listI_assn_def listI_assn_insert nth_list_update_eq pure_false star_false_left star_false_right subst_not_in)
extract_pre_list_assn_lengthD: "h ⊨ list_assn A xs xsi ⟹ length xsi = length xs"
by (metis list_assn_aux_ineq_len mod_false)
method unwrap_idx for i ::nat =
(rewrite in "<⌑>_<_>" list_assn_conv_idx),
(rewrite in "<⌑>_<_>" listI_assn_extract[where i="i"]),
(simp split: if_splits; fail),
(simp split: if_splits; fail)
method wrap_idx uses R =
(rule R),
frame_inference,
(simp split: if_splits; fail),
(simp split: if_splits; fail),
(subst listI_assn_conv, (simp; fail))
method extract_pre_pure uses dest =
(rule hoare_triple_preI | drule asm_rl[of "_⊨_"]),
(determ ‹elim mod_starE dest[elim_format]›)?,
((determ ‹thin_tac "_ ⊨ _"›)+)?,
(simp (no_asm) only: triv_forall_equality)?
lemma rule_at_index:
assumes
1:"P ⟹⇩A list_assn A xs xsi * F" and
2[simp]:"i < length xs" and
3:"<A (xs ! i) (xsi ! i) *
listI_assn ({0..<length xs}- {i}) A xs xsi * F> c <Q'>" and
4: "⋀ r. Q' r ⟹⇩A A (xs ! i) (xsi ! i) *
listI_assn ({0..<length xs}- {i}) A xs xsi* F' r"
shows
"<P>c <λ r. list_assn A xs xsi * F' r> "
apply(rule cons_pre_rule[OF 1])
apply(unwrap_idx i)
apply(rule cons_post_rule)
apply(rule 3)
apply(rule ent_trans[OF 4])
apply(wrap_idx R: listI_assn_reinsert_upd)
apply simp
done
end
Theory VEBT_BuildupMemImp
theory VEBT_BuildupMemImp
imports
VEBT_List_Assn
VEBT_Space
"Deriving.Derive"
VEBT_Member VEBT_Insert
"HOL-Library.Countable"
"Time_Reasoning/Time_Reasoning" VEBT_DeleteBounds
begin
section ‹Imperative van Emde Boas Trees›
datatype VEBTi = Nodei "(nat*nat) option" nat "VEBTi array" VEBTi | Leafi bool bool
derive countable VEBTi
instance VEBTi :: heap by standard
subsection ‹Assertions on van Emde Boas Trees›
fun vebt_assn_raw :: "VEBT ⇒ VEBTi ⇒ assn" where
"vebt_assn_raw (Leaf a b) (Leafi ai bi) = ↑(ai=a ∧ bi=b)"
| "vebt_assn_raw (Node mmo deg tree_list summary) (Nodei mmoi degi tree_array summaryi) = (
↑(mmoi=mmo ∧ degi=deg)
* vebt_assn_raw summary summaryi
* (∃⇩A tree_is. tree_array ↦⇩a tree_is * list_assn vebt_assn_raw tree_list tree_is)
)"
| "vebt_assn_raw _ _ = false"
lemmas [simp del] = vebt_assn_raw.simps
context VEBT_internal begin
lemmas [simp] = vebt_assn_raw.simps
lemma TBOUND_VEBT_case[TBOUND]: assumes "⋀ a b. ti = Leafi a b ⟹ TBOUND (f a b) (bnd a b)"
"⋀ info deg treeArray summary . ti = Nodei info deg treeArray summary ⟹
TBOUND (f' info deg treeArray summary) (bnd' info deg treeArray summary) "
shows "TBOUND (case ti of Leafi a b ⇒ f a b |
Nodei info deg treeArray summary ⇒ f' info deg treeArray summary)
(case ti of Leafi a b ⇒ bnd a b |
Nodei info deg treeArray summary ⇒ bnd' info deg treeArray summary)"
using assms
apply(cases ti)
apply auto
done
text ‹Some Lemmas›
lemma length_corresp:"(∃⇩A tree_is. tree_array ↦⇩a tree_is) = true ⟹ return (length tree_is ) = Array_Time.len tree_array"
proof-
assume "(∃⇩A tree_is. tree_array ↦⇩a tree_is) = true "
then obtain tree_is where " tree_array ↦⇩a tree_is = true"
by (metis mod_h_bot_iff(2) mod_h_bot_iff(4) mod_h_bot_iff(8))
then show ?thesis
by (metis assn_basic_inequalities(5) merge_true_star snga_same_false)
qed
lemma heaphelp:assumes " h ⊨
xa ↦⇩a tree_is * list_assn vebt_assn_raw treeList tree_is *
vebt_assn_raw summary xb *↑(None = None ∧ n = n)*
↑ (xc = Nodei None n xa xb)"
shows "h ⊨ vebt_assn_raw (Node None n treeList summary) xc"
proof-
have "h ⊨ vebt_assn_raw (Node None n treeList summary) (Nodei None n xa xb)"
using vebt_assn_raw.simps(2)[of None n treeList summary None n xa xb] apply simp
by (metis assms mod_pure_star_dist star_aci(2))
then show ?thesis
using assms by auto
qed
lemma assnle:" list_assn vebt_assn_raw treeList tree_is * (x13 ↦⇩a tree_is * vebt_assn_raw summary x14) ⟹⇩A
vebt_assn_raw summary x14 * x13 ↦⇩a tree_is * list_assn vebt_assn_raw treeList tree_is"
using star_aci(2) by auto
lemma ext:" y < length treeList ⟹x13 ↦⇩a tree_is * (vebt_assn_raw summary x14 *
(vebt_assn_raw (treeList ! y) (tree_is ! y) * listI_assn ({0..<length treeList} - {y}) vebt_assn_raw treeList tree_is))
⟹⇩A (x13 ↦⇩a tree_is * vebt_assn_raw summary x14 *
( listI_assn ({0..<length treeList} - {y}) vebt_assn_raw treeList tree_is) )*vebt_assn_raw (treeList ! y) (tree_is ! y) "
by (metis assn_aci(9) ent_refl star_aci(2))
lemma txe:"y < length treeList ⟹ vebt_assn_raw (treeList ! y) (tree_is ! y) * x13 ↦⇩a tree_is * vebt_assn_raw summary x14 *
listI_assn ({0..<length treeList} - {y}) vebt_assn_raw treeList tree_is ⟹⇩A
vebt_assn_raw summary x14 * x13 ↦⇩a tree_is * list_assn vebt_assn_raw treeList tree_is"
by (smt (z3) assn_aci(9) assn_times_comm assnle atLeastLessThan_iff less_nat_zero_code listI_assn_extract list_assn_conv_idx not_less)
lemma recomp: " i < length treeList ⟹ vebt_assn_raw (treeList ! i) (tree_is ! i) *
listI_assn ({0..<length treeList} - {i}) vebt_assn_raw treeList tree_is *
x13 ↦⇩a tree_is *
vebt_assn_raw summary x14 ⟹⇩A
vebt_assn_raw summary x14 * x13 ↦⇩a tree_is * list_assn vebt_assn_raw treeList tree_is"
by (smt (z3) ab_semigroup_mult_class.mult.commute ab_semigroup_mult_class.mult.left_commute atLeastLessThan_iff ent_refl listI_assn_extract list_assn_conv_idx zero_le)
lemma repack: "i < length treeList ⟹
vebt_assn_raw (treeList ! i) (tree_is ! i) *
Rest *
(x13 ↦⇩a tree_is * vebt_assn_raw summary x14 *
listI_assn ({0..<length treeList} - {i}) vebt_assn_raw treeList tree_is)
⟹⇩A Rest* vebt_assn_raw summary x14 * x13 ↦⇩a tree_is * list_assn vebt_assn_raw treeList tree_is"
apply-
by (smt (z3) assn_times_assoc atLeastLessThan_iff entails_def leI less_nat_zero_code listI_assn_extract list_assn_conv_idx mod_pure_star_dist star_aci(2))
lemma big_assn_simp: "h < length treeList ⟹
vebt_assn_raw (vebt_delete(treeList ! h) l) x *
↑ (xaa = vebt_mint (vebt_delete(treeList ! h) l)) *
( x13 ↦⇩a (tree_is [h := x]) *
vebt_assn_raw summary x14 *
listI_assn ({0..<length treeList} - {h}) vebt_assn_raw treeList tree_is) ⟹⇩A
x13 ↦⇩a tree_is[h:=x] * vebt_assn_raw summary x14 * ↑ (xaa = vebt_mint (vebt_delete(treeList ! h) l)) *
list_assn vebt_assn_raw (treeList[h:= (vebt_delete(treeList ! h) l)]) (tree_is[h:= x]) "
by (smt (z3) Diff_iff ab_semigroup_mult_class.mult.left_commute assn_aci(10) atLeastLessThan_iff ent_refl insertCI insert_Diff_single insert_absorb leI length_list_update less_nat_zero_code listI_assn_subst list_assn_conv_idx mult.right_neutral)
lemma tcd: "i < length treeList ⟹ length treeList = length treeList' ⟹
vebt_assn_raw y x * x13 ↦⇩a tree_is[i:= x] * vebt_assn_raw summary x14 * listI_assn ({0..<length treeList} - {i}) vebt_assn_raw (treeList[i :=y]) (tree_is[i := x])
⟹⇩A x13 ↦⇩a tree_is[i:= x] * vebt_assn_raw summary x14 * list_assn vebt_assn_raw (treeList[i :=y]) (tree_is[i := x])"
by (smt (z3) ab_semigroup_mult_class.mult.commute assn_aci(10) atLeastLessThan_iff ent_pure_pre_iff entails_def leI length_list_update less_nat_zero_code listI_assn_def listI_assn_extract list_assn_conv_idx nth_list_update_eq)
lemma big_assn_simp': "h < length treeList ==> xaa = vebt_delete (treeList ! h)l ⟹
vebt_assn_raw xaa x * ↑ (xb = vebt_mint xaa) *
(x13 ↦⇩a tree_is[h := x] * vebt_assn_raw summary x14 *
listI_assn ({0..<length treeList} - {h}) vebt_assn_raw treeList tree_is) ⟹⇩A
(x13 ↦⇩a tree_is[h:= x] * vebt_assn_raw summary x14 * ↑ (xb = vebt_mint xaa) *
list_assn vebt_assn_raw (treeList[h:= xaa]) (tree_is[h:= x]))"
by (smt (verit, best) Diff_iff assn_aci(9) ent_refl insertCI length_list_update listI_assn_weak_cong mult.right_neutral nth_list_update_neq pure_false pure_true star_false_left star_false_right tcd)
lemma refines_case_VEBTi[refines_rule]: assumes "ti = ti'" "⋀ a b. refines (f1 a b) (f1' a b)"
"⋀ info deg treeArray summary . refines (f2 info deg treeArray summary) (f2' info deg treeArray summary) "
shows "refines (case ti of Leafi a b ⇒ f1 a b |
Nodei info deg treeArray summary ⇒ f2 info deg treeArray summary)
(case ti' of Leafi a b⇒ f1' a b |
Nodei info deg treeArray summary ⇒ f2' info deg treeArray summary)"
using assms apply (cases ti') apply simp_all
done
subsection‹High and low Bitsequences Definition›
definition highi::"nat ⇒ nat ⇒ nat Heap" where
"highi x n == return (x div (2^n))"
definition lowi::"nat ⇒ nat ⇒ nat Heap" where
"lowi x n == return (x mod (2^n))"
lemma highi_h: "<emp> highi x n <λ r. ↑(r = high x n)>"
by (simp add: high_def highi_def return_cons_rule)
lemma highi_hT: "<emp> highi x n <λ r. ↑(r = high x n)>T[1]"
by (metis cons_post_rule entails_def highi_def highi_h httI order_refl time_return)
lemma lowi_h: "<emp> lowi x n <λ r. ↑(r = low x n)>"
by (simp add: low_def lowi_def return_cons_rule)
lemma lowi_hT: "<emp> lowi x n <λ r. ↑(r = low x n)>T[1]"
by (metis httI lowi_def lowi_h order_refl time_return)
section ‹Imperative Implementation of $vebt-buildup$›
fun replicatei::"nat ⇒'a Heap ⇒ ('a list) Heap" where
"replicatei 0 x = return []"|
"replicatei (Suc n) x = do{ y <- x;
ys <- replicatei n x;
return (y#ys) }"
lemma time_replicate: "⟦⋀h. time x h ≤ c ⟧ ⟹ time (replicatei n x) h ≤ (1+(1+c)*n)"
apply (induction n arbitrary: h)
apply (simp add: time_simp algebra_simps)
apply (auto simp: time_simp fails_simp algebra_simps)
by (metis add_le_mono group_cancel.add2 nat_arith.suc1)
lemma TBOUND_replicate: "⟦TBOUND x c⟧ ⟹ TBOUND (replicatei n x) (1+(1+c)*n)"
by (meson TBOUND_def time_replicate)
lemma refines_replicate[refines_rule]:
"refines f f' ⟹ refines (replicatei n f) (replicatei n f')"
apply (induction n)
apply simp_all
apply refines
done
fun vebt_buildupi'::"nat ⇒ VEBTi Heap" where
"vebt_buildupi' 0 = return (Leafi False False)"|
"vebt_buildupi' (Suc 0) = return (Leafi False False)"|
"vebt_buildupi' n = (if even n then (let half = n div 2 in do{
treeList <- replicatei (2^half) (vebt_buildupi' half);
assert' (length treeList = 2^half);
trees <- Array_Time.of_list treeList;
summary <- (vebt_buildupi' half);
return (Nodei None n trees summary)})
else (let half = n div 2 in do{
treeList <- replicatei (2^(Suc half)) (vebt_buildupi' half);
assert' (length treeList = 2^Suc half);
trees <- Array_Time.of_list treeList;
summary <- (vebt_buildupi' (Suc half));
return (Nodei None n trees summary)} ))"
end
context begin
interpretation VEBT_internal .
fun vebt_buildupi::"nat ⇒ VEBTi Heap" where
"vebt_buildupi 0 = return (Leafi False False)"|
"vebt_buildupi (Suc 0) = return (Leafi False False)"|
"vebt_buildupi n = (if even n then (let half = n div 2 in do{
treeList <- replicatei (2^half) (vebt_buildupi half);
trees <- Array_Time.of_list treeList;
summary <- (vebt_buildupi half);
return (Nodei None n trees summary)})
else (let half = n div 2 in do{
treeList <- replicatei (2^(Suc half)) (vebt_buildupi half);
trees <- Array_Time.of_list treeList;
summary <- (vebt_buildupi (Suc half));
return (Nodei None n trees summary)} ))"
end
context VEBT_internal begin
lemma vebt_buildupi_refines: "refines (vebt_buildupi n) (vebt_buildupi' n)"
apply (induction n rule: vebt_buildupi.induct)
apply (subst vebt_buildupi.simps; subst vebt_buildupi'.simps; refines)+
done
fun T_vebt_buildupi where
"T_vebt_buildupi 0 = Suc 0"
| "T_vebt_buildupi (Suc 0) = Suc 0"
| "T_vebt_buildupi (Suc (Suc n)) = (
if even n then
Suc (Suc (Suc (T_vebt_buildupi (Suc (n div 2)) +
(4 * 2 ^ (n div 2) + 2 * (T_vebt_buildupi (Suc (n div 2)) * 2 ^ (n div 2))))))
else
Suc (Suc (Suc (T_vebt_buildupi (Suc (Suc (n div 2))) +
(8 * 2 ^ (n div 2) + 4 * (T_vebt_buildupi (Suc (n div 2)) * 2 ^ (n div 2)))))))"
lemma TBOUND_vebt_buildupi:
defines "foo ≡ T_vebt_buildupi"
shows "TBOUND (vebt_buildupi' n) (foo n)"
supply [simp del] = vebt_buildupi'.simps
supply [TBOUND] = TBOUND_replicate
apply (induction n rule: vebt_buildupi.induct)
apply (subst vebt_buildupi'.simps)
apply (rule TBOUND_mono)
apply (TBOUND_step)
apply(rule asm_rl[of "_ ≤ _"])
apply defer_le
apply (subst vebt_buildupi'.simps)
apply (rule TBOUND_mono)
apply (TBOUND_step)
apply(rule asm_rl[of "_ ≤ _"])
apply defer_le
apply (subst vebt_buildupi'.simps)
apply (rule TBOUND_mono)
apply TBOUND_step+
apply(rule asm_rl[of "_ ≤ _"])
apply defer_le
apply (all ‹((determ ‹thin_tac ‹TBOUND _ _››)+)? ›)
apply (simp_all add: foo_def)
done
lemma T_vebt_buildupi: "time (vebt_buildupi' n) h ≤ T_vebt_buildupi n"
using TBOUND_vebt_buildupi[THEN TBOUNDD] .
lemma repli_cons_repl: "<Q> x <λ r. Q* A y r > ⟹ <Q> replicatei n x <λ r. Q*list_assn A (replicate n y) r >"
proof(induction n arbitrary: Q)
case (Suc n)
then show ?case
apply (sep_auto heap: "Suc.IH"(1))
apply (smt (z3) assn_aci(10) cons_post_rule ent_refl fi_rule)
apply sep_auto
done
qed sep_auto
corollary repli_emp: "<emp> x <λ r. A y r > ⟹ <emp> replicatei n x <λ r. list_assn A (replicate n y) r >"
apply(rule cons_post_rule)
apply(rule repli_cons_repl[where Q = emp])
apply sep_auto+
done
lemma builupi'corr: "<emp> vebt_buildupi' n <λ r. vebt_assn_raw (vebt_buildup n) r>"
proof(induction n rule: vebt_buildup.induct)
case (3 n)
then show ?case
proof(cases "even (Suc (Suc n))")
case True
then show ?thesis
apply( simp add: vebt_buildupi'.simps(2))
apply(rule bind_rule)
apply(sep_auto heap: repli_cons_repl)
apply(rule "3.IH"(1))
apply simp+
apply sep_auto
apply (extract_pre_pure dest: extract_pre_list_assn_lengthD; simp)
apply (sep_auto heap: "3.IH"(1))
done
next
case False
hence 11:" <xa ↦⇩a x * list_assn vebt_assn_raw (replicate (4 * 2 ^ (n div 2)) (vebt_buildup (Suc (n div 2)))) x>
vebt_buildupi' (Suc (Suc (Suc n) div 2)) <λ r. xa ↦⇩a x * list_assn vebt_assn_raw (replicate (4 * 2 ^ (n div 2)) (vebt_buildup (Suc (n div 2)))) x *
vebt_assn_raw ( vebt_buildup (Suc (Suc (Suc n) div 2))) r>" for xa x
proof -
show ?thesis
by (metis (no_types) "3.IH"(4) False frame_rule_left mult.right_neutral)
qed
hence "vebt_buildupi' (Suc (Suc n)) = do{ treeList <- replicatei (2^(Suc ((Suc (Suc n)) div 2))) (vebt_buildupi' ((Suc (Suc n)) div 2));
assert' (length treeList = (2^(Suc ((Suc (Suc n)) div 2))));
trees <- Array_Time.of_list treeList;
summary <- (vebt_buildupi' (Suc ((Suc (Suc n)) div 2)));
return (Nodei None (Suc (Suc n)) trees summary)}"
using vebt_buildupi'.simps(3)[of n] Let_def False
by auto
moreover have "<emp> do{treeList <- replicatei (2^(Suc ((Suc (Suc n)) div 2))) (vebt_buildupi' ((Suc (Suc n)) div 2));
assert' (length treeList = (2^(Suc ((Suc (Suc n)) div 2))));
trees <- Array_Time.of_list treeList;
summary <- (vebt_buildupi' (Suc ((Suc (Suc n)) div 2)));
return (Nodei None (Suc (Suc n)) trees summary)} <vebt_assn_raw (vebt_buildup (Suc (Suc n)))>"
apply(rule bind_rule)
apply(sep_auto heap: repli_cons_repl)
apply(rule "3.IH"(3))
using False apply simp
using False apply simp
apply(rule assert'_bind_rule)
apply (extract_pre_pure dest: extract_pre_list_assn_lengthD; simp)
apply(rule bind_rule)
apply sep_auto
apply(rule bind_rule)
apply (rule 11)
apply vcg
proof-
fix x xa xb xc
show " xa ↦⇩a x * list_assn vebt_assn_raw (replicate (4 * 2 ^ (n div 2)) (vebt_buildup (Suc (n div 2)))) x *
vebt_assn_raw (vebt_buildup (Suc (Suc (Suc n) div 2))) xb * ↑ (xc = Nodei None (Suc (Suc n)) xa xb) ⟹⇩A vebt_assn_raw (vebt_buildup (Suc (Suc n))) xc"
apply(rule entailsI)
proof-
fix h
assume " h ⊨xa ↦⇩a x * list_assn vebt_assn_raw (replicate (4 * 2 ^ (n div 2)) (vebt_buildup (Suc (n div 2)))) x *
vebt_assn_raw (vebt_buildup (Suc (Suc (Suc n) div 2))) xb * ↑ (xc = Nodei None (Suc (Suc n)) xa xb)"
then show " h ⊨ vebt_assn_raw (vebt_buildup (Suc (Suc n))) xc"
using heaphelp by (smt (z3) False SLN_def SLN_right ab_semigroup_mult_class.mult.commute ab_semigroup_mult_class.mult.left_commute vebt_buildup.simps(3) div2_Suc_Suc even_numeral even_two_times_div_two numeral_Bit0_div_2 power_Suc power_commutes pure_true)
qed
qed
then show ?thesis using calculation
by presburger
qed
qed sep_auto+
lemma htt_vebt_buildupi': "< emp> (vebt_buildupi' n) <λ r. vebt_assn_raw (vebt_buildup n) r> T [T_vebt_buildupi n]"
apply (rule httI_TBOUND)
apply (rule builupi'corr)
apply (rule TBOUND_vebt_buildupi)
done
lemma builupicorr: "<emp> vebt_buildupi n <λ r. vebt_assn_raw (vebt_buildup n) r>"
using vebt_buildupi_refines builupi'corr hoare_triple_refines by blast
lemma htt_vebt_buildupi: "<emp> (vebt_buildupi n) <λ r. vebt_assn_raw (vebt_buildup n) r> T [T_vebt_buildupi n]"
apply (rule htt_refine)
apply (rule htt_vebt_buildupi')
apply (rule vebt_buildupi_refines)
done
text ‹Closed bound for $T-vebt-buildupi$›
text ‹Amortization›
lemma T_vebt_buildupi_gq_0: "T_vebt_buildupi n > 0"
apply(induction n rule : T_vebt_buildupi.induct)
apply auto
done
fun T_vebt_buildupi'::"nat ⇒ int" where
"T_vebt_buildupi' 0 = 1"
| "T_vebt_buildupi' (Suc 0) = 1"
| "T_vebt_buildupi' (Suc (Suc n)) = (
if even n then
3+(T_vebt_buildupi' (Suc (n div 2)) +
(4 * 2 ^ (n div 2) + 2 * (T_vebt_buildupi' (Suc (n div 2)) * 2 ^ (n div 2))))
else
3+ (T_vebt_buildupi' (Suc (Suc (n div 2))) +
(8 * 2 ^ (n div 2) + 4 * (T_vebt_buildupi' (Suc (n div 2)) * 2 ^ (n div 2)))))"
lemma Tbuildupi_buildupi': "T_vebt_buildupi n = T_vebt_buildupi' n"
by(induction n rule: T_vebt_buildupi.induct) auto
fun Tb::"nat ⇒ int" where
"Tb 0 = 3"
| "Tb (Suc 0) =3"
| "Tb (Suc (Suc n)) = (
if even n then
5+ Tb (Suc (n div 2)) + (Tb (Suc (n div 2))) * 2 ^ (Suc (n div 2))
else
5 + Tb (Suc (Suc (n div 2))) + (Tb (Suc (n div 2))) * 2 ^(Suc (Suc (n div 2))))"
lemma Tb_T_vebt_buildupi': "T_vebt_buildupi' n ≤ Tb n - 2"
proof(induction n rule: T_vebt_buildupi.induct)
case 1
then show ?case
apply(subst Tb.simps)
apply(subst T_vebt_buildupi'.simps)
apply simp
done
next
case 2
then show ?case
apply(subst Tb.simps)
apply(subst T_vebt_buildupi'.simps)
apply simp
done
next
case (3 n)
then show ?case
proof(cases "even (Suc (Suc n))")
case True
then show ?thesis
apply(subst Tb.simps)
apply(subst T_vebt_buildupi'.simps)
using True apply simp
thm 3
proof-
have 0:"T_vebt_buildupi' (Suc (n div 2)) +
(4 * 2 ^ (n div 2) + 2 * (T_vebt_buildupi' (Suc (n div 2)) * 2 ^ (n div 2)))
≤ Tb (Suc (n div 2)) - 2 + 2^(Suc (n div 2))*2 +
2^(Suc (n div 2)) * (T_vebt_buildupi' (Suc (n div 2)))"
using "3.IH"(1) True algebra_simps by simp
moreover have 1:"2^(Suc (n div 2))*2 +
2^(Suc (n div 2)) * (T_vebt_buildupi' (Suc (n div 2))) =
2^(Suc (n div 2)) * (T_vebt_buildupi' (Suc (n div 2)) + 2)" by algebra
ultimately have 2:"T_vebt_buildupi' (Suc (n div 2)) +
(4 * 2 ^ (n div 2) + 2 * (T_vebt_buildupi' (Suc (n div 2)) * 2 ^ (n div 2)))
≤ Tb (Suc (n div 2)) - 2 +
2^(Suc (n div 2)) * (T_vebt_buildupi' (Suc (n div 2)) + 2)"by linarith
hence 3:" (4 * 2 ^ (n div 2) + 2 * (T_vebt_buildupi' (Suc (n div 2))) * 2 ^ (n div 2))
≤ 2* 2^(Suc (n div 2))+ 2^(Suc (n div 2)) * ((Tb (Suc (n div 2)) - 2))"
using "3.IH"(1) True by simp
hence 4:" (4 * 2 ^ (n div 2) + 2 * (T_vebt_buildupi' (Suc (n div 2))) * 2 ^ (n div 2))
≤ 2^(Suc (n div 2)) * ((Tb (Suc (n div 2)) - 2) + 2)"
using algebra_simps by (smt (verit, del_insts) "1")
hence 4:" T_vebt_buildupi' (Suc (n div 2)) +
(4 * 2 ^ (n div 2) + 2 * (T_vebt_buildupi' (Suc (n div 2))) * 2 ^ (n div 2))
≤ Tb (Suc (n div 2)) - (2::int) + 2^(Suc (n div 2)) * (Tb (Suc (n div 2)))"
using "3.IH"(1) True by simp
have 5:" (x::int) ≤ (y::int) - (z::int) + a ⟹ z ≥ 0 ⟹ x ≤ y + a" for x y z a by simp
have "T_vebt_buildupi' (Suc (n div 2)) +
(4 * 2 ^ (n div 2) + 2 * (T_vebt_buildupi' (Suc (n div 2)) * 2 ^ (n div 2)))
≤ Tb (Suc (n div 2)) + 2^(Suc (n div 2)) * (Tb (Suc (n div 2)))" using
5[of " T_vebt_buildupi' (Suc (n div 2)) +
(4 * 2 ^ (n div 2) + 2 * (T_vebt_buildupi' (Suc (n div 2))) * 2 ^ (n div 2))"
" Tb (Suc (n div 2))" 2 "Tb (Suc (n div 2)) * (2 * 2 ^ (n div 2))"] 4 by simp
then show "T_vebt_buildupi' (Suc (n div 2)) +
(4 * 2 ^ (n div 2) + 2 * (T_vebt_buildupi' (Suc (n div 2)) * 2 ^ (n div 2)))
≤ Tb (Suc (n div 2)) + Tb (Suc (n div 2)) * (2 * 2 ^ (n div 2))"
using power_Suc [of 2 "(n div 2)"] mult.commute by metis
qed
next
case False
have "3 +
(T_vebt_buildupi' (Suc (Suc (n div 2))) +
(8 * 2 ^ (n div 2) + 4 * (T_vebt_buildupi' (Suc (n div 2)) * 2 ^ (n div 2))))
≤ 5 + Tb (Suc (Suc (n div 2))) + Tb (Suc (n div 2)) * 2 ^ Suc (Suc (n div 2)) - 2"
proof-
have 0:"3 +
(T_vebt_buildupi' (Suc (Suc (n div 2))) +
(8 * 2 ^ (n div 2) + 4 * (T_vebt_buildupi' (Suc (n div 2)) * 2 ^ (n div 2))))
≤ 1 + Tb (Suc (Suc (n div 2))) + (8 * 2 ^ (n div 2) + 4 * (T_vebt_buildupi' (Suc (n div 2)) * 2 ^ (n div 2)))"
using "3.IH"(3) False by simp
moreover have " 4 * (T_vebt_buildupi' (Suc (n div 2))*2 ^ (n div 2)) ≤
4 * ((Tb (Suc (n div 2)) - 2) * 2 ^ (n div 2))"
using "3.IH"(4) False algebra_simps by simp
moreover have "8 * 2 ^ (n div 2) + 4 * ((Tb (Suc (n div 2)) - 2) * 2 ^ (n div 2)) =
4* (2 * 2 ^ (n div 2) + ((Tb (Suc (n div 2)) - 2) * 2 ^ (n div 2)))" by simp
moreover have "4* (2 * 2 ^ (n div 2) + ((Tb (Suc (n div 2)) - 2) * 2 ^ (n div 2))) =
4* ( ((Tb (Suc (n div 2)) - 2) + 2) * 2 ^ (n div 2))" by algebra
moreover hence "4* (2 * 2 ^ (n div 2) + ((Tb (Suc (n div 2)) - 2) * 2 ^ (n div 2))) =
4* ((Tb (Suc (n div 2)) ) * 2 ^ (n div 2))" by simp
ultimately have "8 * 2 ^ (n div 2) + 4 * (T_vebt_buildupi' (Suc (n div 2))*2 ^ (n div 2)) ≤
4 * (((Tb (Suc (n div 2))-2) + 2 ) * 2 ^ (n div 2))" by presburger
then show ?thesis using 0 by force
qed
then show ?thesis
apply(subst Tb.simps)
apply(subst T_vebt_buildupi'.simps)
using False by simp
qed qed
fun Tb'::"nat ⇒ nat" where
"Tb' 0 = 3"
| "Tb' (Suc 0) =3"
| "Tb' (Suc (Suc n)) = (
if even n then
5+ Tb' (Suc (n div 2)) + (Tb' (Suc (n div 2))) * 2 ^ (Suc (n div 2))
else
5 + Tb' (Suc (Suc (n div 2))) + (Tb' (Suc (n div 2))) * 2 ^(Suc (Suc (n div 2))))"
lemma Tb_Tb': "Tb t = Tb' t"
by(induction t rule: Tb.induct) auto
lemma Tb_T_vebt_buildupi: "T_vebt_buildupi n ≤ Tb n - 2"
using Tb_T_vebt_buildupi' Tbuildupi_buildupi' by simp
lemma Tb_T_vebt_buildupi'': "T_vebt_buildupi n ≤ Tb' n - 2"
using Tb_T_vebt_buildupi[of n] Tb_Tb' by simp
lemma Tb'_cnt: "Tb' n ≤ 5 * cnt' (vebt_buildup n)"
proof(induction n rule: vebt_buildup.induct)
case (3 n)
then show ?case
proof(cases "even n")
case True
have 0:" 5 + Tb' (Suc (n div 2)) + Tb' (Suc (n div 2)) * 2 ^ Suc (n div 2)
≤ 5 * cnt' ( let half = Suc (Suc n) div 2
in Node None (Suc (Suc n)) (replicate (2 ^ half) (vebt_buildup half))
(vebt_buildup half))"
unfolding Let_def
apply(subst cnt'.simps)
proof-
have 0:"5 * (1 + cnt' (vebt_buildup (Suc (Suc n) div 2)) +
foldr (+)
(map cnt' (replicate (2 ^ (Suc (Suc n) div 2)) (vebt_buildup (Suc (Suc n) div 2)))) 0) =
5 * (1 + cnt' (vebt_buildup (Suc (Suc n) div 2)) + (2 ^ (Suc (Suc n) div 2)) * cnt' (vebt_buildup (Suc (Suc n) div 2)))"
using map_replicate[of cnt' "(2 ^ (Suc (Suc n) div 2))" "(vebt_buildup (Suc (Suc n) div 2))"]
foldr_same_int[of "replicate (2 ^ (Suc (Suc n) div 2)) (cnt' (vebt_buildup (Suc (Suc n) div 2)))"
"(cnt' (vebt_buildup (Suc (Suc n) div 2)))"] length_replicate by simp
have 1:" Tb' (Suc (n div 2)) * 2 ^ Suc (n div 2)
≤ 5 * (2 ^ (Suc (Suc n) div 2) * cnt' (vebt_buildup (Suc (Suc n) div 2)))"
using True "3.IH"(1)[of "Suc (Suc n) div 2"] by simp
have 2:" Tb' (Suc (n div 2)) ≤ 5 * cnt' (vebt_buildup (Suc (Suc n) div 2))"
using True "3.IH"(1)[of "Suc (Suc n) div 2"] by simp
show "5 + Tb' (Suc (n div 2)) + Tb' (Suc (n div 2)) * 2 ^ Suc (n div 2)
≤ 5 * (1 + cnt' (vebt_buildup (Suc (Suc n) div 2)) +
foldr (+)
(map cnt' (replicate (2 ^ (Suc (Suc n) div 2)) (vebt_buildup (Suc (Suc n) div 2)))) 0)"
apply(rule ord_le_eq_trans[where b = "5 * (1 + cnt' (vebt_buildup (Suc (Suc n) div 2))
+ (2 ^ (Suc (Suc n) div 2)) * cnt' (vebt_buildup (Suc (Suc n) div 2)))"])
defer
using 0 apply simp
using 1 2 "order.trans" trans_le_add1 algebra_simps
by (smt (z3) add_le_cancel_left add_mono_thms_linordered_semiring(1) mult_Suc_right plus_1_eq_Suc)
qed
show ?thesis
apply (subst vebt_buildup.simps)
apply(subst Tb'.simps)
using 0 True apply simp
done
next
case False
have 0:" 5 + Tb' (Suc (Suc (n div 2))) + Tb' (Suc (n div 2)) * 2 ^ Suc (Suc (n div 2))
≤ 5 * cnt' ( let half = Suc (Suc n) div 2
in Node None (Suc (Suc n)) (replicate (2 ^ Suc half) (vebt_buildup half))
(vebt_buildup (Suc half)))"
unfolding Let_def
apply(subst cnt'.simps)
proof-
have 0:"5 * (1 + cnt' (vebt_buildup (Suc (Suc (Suc n) div 2))) +
foldr (+) (map cnt' (replicate (2 ^ Suc (Suc (Suc n) div 2)) (vebt_buildup (Suc (Suc n) div 2))))0)
= 5 * (1 + cnt' (vebt_buildup (Suc (Suc (Suc n) div 2))) + (2 ^ Suc (Suc (Suc n) div 2)) * cnt' (vebt_buildup (Suc (Suc n) div 2)))"
using map_replicate[of cnt' "(2 ^ Suc (Suc (Suc n) div 2))" "(vebt_buildup (Suc (Suc n) div 2))"]
foldr_same_int[of "replicate (2 ^ Suc (Suc (Suc n) div 2)) (cnt' (vebt_buildup (Suc (Suc n) div 2)))"
"(cnt' (vebt_buildup (Suc (Suc n) div 2)))"] length_replicate by simp
have 1:" Tb' (Suc (n div 2)) * 2 ^ ((Suc n) div 2)
≤ 5 * (2 ^ (Suc (Suc n) div 2) * cnt' (vebt_buildup (Suc (Suc n) div 2)))"
using False "3.IH"(3)[of " (Suc (Suc n) div 2)"] by simp
have 2:" Tb' (Suc (Suc (n div 2))) ≤ 5 * cnt' (vebt_buildup (Suc (Suc (Suc n) div 2)))"
using False "3.IH"(4)[of "(Suc n) div 2"] by simp
show " 5 + Tb' (Suc (Suc (n div 2))) + Tb' (Suc (n div 2)) * 2 ^ Suc (Suc (n div 2))
≤ 5 * (1 + cnt' (vebt_buildup (Suc (Suc (Suc n) div 2))) +
foldr (+)
(map cnt' (replicate (2 ^ Suc (Suc (Suc n) div 2)) (vebt_buildup (Suc (Suc n) div 2)))) 0)"
apply(rule ord_le_eq_trans[where b = "5 * (1 + cnt' (vebt_buildup (Suc (Suc (Suc n) div 2)))
+ (2 ^ Suc (Suc (Suc n) div 2)) * cnt' (vebt_buildup (Suc (Suc n) div 2)))"])
defer
using 0 apply simp
using 1 2 "order.trans" trans_le_add1 algebra_simps
by (smt (z3) "3.IH"(3) False add_le_cancel_left add_mono_thms_linordered_semiring(1) diff_diff_cancel diff_le_self div2_Suc_Suc even_Suc mult_Suc_right plus_1_eq_Suc)
qed
show ?thesis
apply (subst vebt_buildup.simps)
apply(subst Tb'.simps)
using 0 False apply simp
done
qed
qed (subst vebt_buildup.simps cnt'.simps Tb'.simps , simp )+
lemma T_vebt_buildupi_cnt': "T_vebt_buildupi n ≤ 5 * cnt (vebt_buildup n)"
apply(rule ord_le_eq_trans[where b = "real (5 * cnt' (vebt_buildup n))"])
defer
apply(simp add: cnt_cnt_eq)
apply(rule of_nat_mono)
apply(rule order.trans[])
apply(rule Tb_T_vebt_buildupi'')
apply(rule order.trans[where b = "Tb' n"])
apply simp
apply(rule Tb'_cnt)
done
lemma T_vebt_buildupi_univ:
assumes "u =2^n "
shows "T_vebt_buildupi n ≤10 * u"
proof-
have "cnt (vebt_buildup n) ≤ 2 * u"
using count_buildup[of n] assms by simp
hence "real (T_vebt_buildupi n) ≤ 5 * 2 * u"
using T_vebt_buildupi_cnt'[of n] by simp
then show ?thesis by simp
qed
lemma htt_vebt_buildupi'_univ:
assumes "u = 2^n"
shows
"< emp> (vebt_buildupi' n) <λ r. vebt_assn_raw (vebt_buildup n) r> T [10 * u]"
apply (rule httI_TBOUND)
apply (rule builupi'corr)
apply (rule TBOUND_mono[where t = "T_vebt_buildupi n"])
apply (rule TBOUND_vebt_buildupi)
using T_vebt_buildupi_univ[of u n] assms apply simp
done
text ‹We obtain the main theorem for $buildupi$›
lemma htt_vebt_buildupi_univ:
assumes "u = 2^n"
shows
"< emp> (vebt_buildupi n) <λ r. vebt_assn_raw (vebt_buildup n) r> T [10 * u]"
using vebt_buildupi_refines
by (metis VEBT_internal.htt_vebt_buildupi'_univ assms htt_refine)
lemma vebt_buildupi_rule: "<↑ (n > 0)> vebt_buildupi n <λ r. vebt_assn_raw (vebt_buildup n) r > T[10 * 2^n]"
proof-
have vebt_buildupi'_rule: "<↑ (n > 0)> vebt_buildupi' n <λ r. vebt_assn_raw (vebt_buildup n) r >"
using builupicorr[of n]
apply simp
using VEBT_internal.builupi'corr by blast
have vebt_buildupi'_rule_univ: "<↑ (n > 0)> vebt_buildupi' n <λ r. vebt_assn_raw (vebt_buildup n) r > T[10 * 2^n]"
apply (rule httI_TBOUND)
apply(rule vebt_buildupi'_rule)
apply(rule TBOUND_refines[where c = "vebt_buildupi' n"])
apply(rule TBOUND_mono[where t="T_vebt_buildupi n"])
apply(rule TBOUND_vebt_buildupi)
using T_vebt_buildupi_univ[of "2^n" n]
apply simp
apply(rule refines_refl)
done
show ?thesis
using vebt_buildupi_refines htt_refine vebt_buildupi'_rule_univ by blast
qed
lemma TBOUND_buildupi: assumes "n>0" shows " TBOUND (vebt_buildupi n) (10 * 2 ^ n)"
using vebt_buildupi_rule[of n] unfolding htt_def TBOUND_def
apply auto
subgoal for h
using time_return[of "Leafi False False" h] by simp
subgoal for h
using time_return[of "Leafi False False" h] by simp
done
section ‹Minimum and Maximum Determination›
end
context begin
interpretation VEBT_internal .
fun vebt_minti::"VEBTi ⇒ nat option Heap" where
"vebt_minti (Leafi a b) = (if a then return ( Some 0) else if b then return (Some 1) else return None)"|
"vebt_minti (Nodei None _ _ _) = return None"|
"vebt_minti (Nodei (Some (mi,ma)) _ _ _ ) = return (Some mi)"
fun vebt_maxti::"VEBTi ⇒ nat option Heap" where
"vebt_maxti (Leafi a b) = (if b then return (Some 1) else if a then return (Some 0) else return None)"|
"vebt_maxti (Nodei None _ _ _) = return None"|
"vebt_maxti (Nodei (Some (mi,ma)) _ _ _ ) = return (Some ma)"
end
context VEBT_internal begin
lemma vebt_minti_h:"<vebt_assn_raw t ti> vebt_minti ti <λr. vebt_assn_raw t ti * ↑(r = vebt_mint t)>"
by (cases t rule: vebt_mint.cases; cases ti rule: vebt_minti.cases) (sep_auto+)
lemma vebt_maxti_h:"<vebt_assn_raw t ti> vebt_maxti ti <λr. vebt_assn_raw t ti * ↑(r = vebt_maxt t)>"
by (cases t rule: vebt_mint.cases; cases ti rule: vebt_minti.cases) (sep_auto+)
lemma TBOUND_vebt_maxti[TBOUND]: "TBOUND (vebt_maxti t) 1"
apply (induction t rule: vebt_maxti.induct)
apply (subst vebt_maxti.simps| TBOUND_step)+
done
lemma TBOUND_vebt_minti[TBOUND]: "TBOUND (vebt_minti t) 1"
apply (induction t rule: vebt_minti.induct)
apply (subst vebt_minti.simps| TBOUND_step)+
done
lemma vebt_minti_hT:"<vebt_assn_raw t ti> vebt_minti ti <λr. vebt_assn_raw t ti * ↑(r = vebt_mint t)>T[1]"
using TBOUND_vebt_minti httI_TBOUND vebt_minti_h by blast
lemma vebt_maxti_hT:"<vebt_assn_raw t ti> vebt_maxti ti <λr. vebt_assn_raw t ti * ↑(r = vebt_maxt t)>T[1]"
using TBOUND_vebt_maxti httI_TBOUND vebt_maxti_h by blast
lemma vebt_maxtilist:"i < length ts ⟹
<list_assn vebt_assn_raw ts tsi> vebt_maxti (tsi ! i)
< λ r. ↑(r = vebt_maxt (ts ! i)) *list_assn vebt_assn_raw ts tsi>"
apply(unwrap_idx i)
apply (sep_auto heap: vebt_maxti_h)
apply(wrap_idx R: listI_assn_reinsert_upd)
apply sep_auto
done
lemma vebt_mintilist:"i < length ts ⟹
<list_assn vebt_assn_raw ts tsi> vebt_minti (tsi ! i)
< λ r. ↑(r = vebt_mint (ts ! i)) *list_assn vebt_assn_raw ts tsi>"
apply(unwrap_idx i)
apply (sep_auto heap: vebt_minti_h)
apply(wrap_idx R: listI_assn_reinsert_upd)
apply sep_auto
done
section ‹Membership Test on imperative van Emde Boas Trees›
end
context begin
interpretation VEBT_internal .
partial_function (heap_time) vebt_memberi::"VEBTi ⇒ nat ⇒ bool Heap" where
"vebt_memberi t x =
(case t of
(Leafi a b ) ⇒ return (if x = 0 then a else if x=1 then b else False) |
(Nodei info deg treeList summary ) ⇒ (
case info of None ⇒ return False |
(Some (mi, ma)) ⇒ ( if deg ≤ 1 then return False else (
if x = mi then return True else
if x = ma then return True else
if x < mi then return False else
if x > ma then return False else
(do {
h ← highi x (deg div 2);
l ← lowi x (deg div 2);
len ← Array_Time.len treeList;
if h < len then do {
th ← Array_Time.nth treeList h;
vebt_memberi th l
} else return False
})))))"
end
context VEBT_internal begin
partial_function (heap_time) vebt_memberi'::"VEBT ⇒VEBTi ⇒ nat ⇒ bool Heap" where
"vebt_memberi' t ti x =
(case ti of
(Leafi a b ) ⇒ return (if x = 0 then a else if x=1 then b else False) |
(Nodei info deg treeArray summary ) ⇒ ( do {assert' (is_Node t);
case info of None ⇒ return False |
(Some (mi, ma)) ⇒ ( if deg ≤ 1 then return False else (
if x = mi then return True else
if x = ma then return True else
if x < mi then return False else
if x > ma then return False else
(do {
let (info',deg',treeList,summary') =
(case t of (Node info' deg' treeList summary') ⇒
(info', deg', treeList, summary'));
assert'(info= info' ∧ deg = deg');
h ← highi x (deg div 2);
l ← lowi x (deg div 2);
assert'(l = low x (deg div 2) ∧ h = high x (deg div 2));
len ← Array_Time.len treeArray;
assert'(len = length treeList);
if h < len then do {
assert'(h = high x (deg div 2) ∧ h < length treeList);
th ← Array_Time.nth treeArray h;
vebt_memberi' (treeList ! h) th l }
else return False
})))}))"
lemma highsimp: "return (high x n) = highi x n"
by (simp add: high_def highi_def)
lemma lowsimp: "return (low x n) = lowi x n"
by (simp add: low_def lowi_def)
lemma TBOUND_highi[TBOUND]: "TBOUND (highi x n) 1"
unfolding highi_def
apply TBOUND_step
done
lemma TBOUND_lowi[TBOUND]: "TBOUND (lowi x n) 1"
unfolding lowi_def
apply TBOUND_step
done
text ‹Correctness of $vebt-memberi$›
lemma vebt_memberi'_rf_abstr:" <vebt_assn_raw t ti> vebt_memberi' t ti x <λr. vebt_assn_raw t ti * ↑(r = vebt_member t x)>"
proof(induction t x arbitrary: ti rule: vebt_member.induct)
case (1 a b x)
then show ?case apply (subst vebt_memberi'.simps) by(cases ti; sep_auto)
next
case (2 uu uv uw x)
then show ?case apply (subst vebt_memberi'.simps) by(cases ti; sep_auto)
next
case (3 v uy uz x)
then show ?case apply (subst vebt_memberi'.simps) by(cases ti; sep_auto)
next
case (4 v vb vc x)
then show ?case apply (subst vebt_memberi'.simps) by(cases ti; sep_auto)
next
case (5 mi ma va treeList summary x)
note IH[sep_heap_rules] = "5.IH"
show ?case
apply (subst vebt_memberi'.simps) unfolding highi_def lowi_def
apply (cases ti;sep_auto)
apply(simp add: low_def )
apply(simp add: high_def )
apply sep_auto
apply (extract_pre_pure dest: extract_pre_list_assn_lengthD)
apply(simp add: high_def)
apply sep_auto
apply (extract_pre_pure dest: extract_pre_list_assn_lengthD)
subgoal
apply (extract_pre_pure dest: extract_pre_list_assn_lengthD)
apply (rewrite in "<⌑>_<_>" list_assn_conv_idx)
apply (rewrite in "<⌑>_<_>" listI_assn_extract[where i="(x div (2 * 2 ^ (va div 2)))"])
apply simp
apply simp
apply (sep_auto simp: high_def low_def)
apply (rule listI_assn_reinsert)
apply frame_inference
apply simp
apply simp
apply (rewrite in "⌑ ⟹⇩A _" list_assn_conv_idx[symmetric])
apply sep_auto
done
apply (extract_pre_pure dest: extract_pre_list_assn_lengthD)
apply (sep_auto simp: high_def)
done
qed
lemma TBOUND_vebt_memberi:
defines foo_def: "⋀ t x. foo t x ≡ 4 * (1+height t)"
shows "TBOUND (vebt_memberi' t ti x) (foo t x)"
apply (induction arbitrary: t ti x rule: vebt_memberi'.fixp_induct)
apply (rule TBOUND_fi'_adm)
apply (rule TBOUND_empty)
subgoal for f t ti x
apply(rule TBOUND_mono)
apply ( TBOUND_step)+
unfolding foo_def
apply (auto split: VEBTi.splits option.splits VEBT.splits)
apply (meson List.finite_set Max_ge finite_imageI imageI le_max_iff_disj nth_mem)
done
done
lemma vebt_memberi_refines: "refines (vebt_memberi ti x) (vebt_memberi' t ti x)"
apply (induction arbitrary: t ti x rule: vebt_memberi'.fixp_induct)
subgoal using refines_adm[where t = "λ arg. vebt_memberi (snd (fst arg)) (snd arg)"]
by simp
subgoal by simp
subgoal for f t ti x
apply(subst vebt_memberi.simps)
apply refines
done
done
lemma htt_vebt_memberi:
"<vebt_assn_raw t ti>vebt_memberi ti x <λ r. vebt_assn_raw t ti * ↑(r = vebt_member t x)>T[ 5 + 5 * height t]"
apply (rule htt_refine[where c = "vebt_memberi' t ti x"])
prefer 2
apply(rule vebt_memberi_refines)
apply (rule httI_TBOUND)
apply(rule vebt_memberi'_rf_abstr)
apply(rule TBOUND_mono)
apply(rule TBOUND_vebt_memberi)
apply simp
done
lemma htt_vebt_memberi_invar_vebt: assumes "invar_vebt t n" shows
"<vebt_assn_raw t ti> vebt_memberi ti x <λ r. vebt_assn_raw t ti * ↑(r = vebt_member t x)>T[5 + 5 * (nat ⌈lb n ⌉)]"
by (metis assms heigt_uplog_rel htt_vebt_memberi nat_int)
subsection ‹$minNulli$: empty tree?›
fun minNulli::"VEBTi ⇒ bool Heap" where
"minNulli (Leafi False False) = return True"|
"minNulli (Leafi _ _ ) = return False"|
"minNulli (Nodei None _ _ _) = return True"|
"minNulli (Nodei (Some _) _ _ _) = return False"
lemma minNulli_rule[sep_heap_rules]: "<vebt_assn_raw t ti> minNulli ti <λr. vebt_assn_raw t ti * ↑(r = minNull t)>"
by (cases t rule: minNull.cases; cases ti rule: minNulli.cases) (sep_auto+)
lemma TBOUND_minNulli[TBOUND]: "TBOUND (minNulli t) 1"
apply (induction t rule: minNulli.induct)
apply (subst minNulli.simps | TBOUND_step)+
done
lemma minNrulli_ruleT:
"<vebt_assn_raw t ti> minNulli ti <λr. vebt_assn_raw t ti * ↑(r = minNull t)>T[1]"
by (metis TBOUND_minNulli hoare_triple_def httI_TBOUND minNulli_rule)
section ‹Imperative $vebt-insert$ to van Emde Boas Tree›
end
context begin
interpretation VEBT_internal .
partial_function (heap_time) vebt_inserti::"VEBTi ⇒ nat ⇒VEBTi Heap" where
"vebt_inserti t x = (case t of
(Leafi a b) ⇒ (if x=0 then return (Leafi True b) else if x=1
then return (Leafi a True) else return (Leafi a b)) |
(Nodei info deg treeArray summary) ⇒ ( case info of None ⇒
if deg ≤ 1 then
return (Nodei info deg treeArray summary)
else
return (Nodei (Some (x,x)) deg treeArray summary)|
(Some minma) ⇒
( if deg ≤ 1
then return (Nodei info deg treeArray summary)
else ( do{
mi <- return (fst minma);
ma <- return (snd minma);
xn <- (if x < mi then return mi else return x);
minn <- (if x < mi then return x else return mi);
l<- lowi xn (deg div 2);
h <- highi xn (deg div 2);
len ← Array_Time.len treeArray;
if h < len ∧ ¬ (x = mi ∨ x = ma) then do {
node <- Array_Time.nth treeArray h;
empt <- minNulli node;
newnode <- vebt_inserti node l;
newarray <- Array_Time.upd h newnode treeArray;
newsummary<-(if empt then
vebt_inserti summary h
else return summary);
man <- (if xn > ma then return xn else return ma);
return (Nodei (Some (minn, man)) deg newarray newsummary)}
else return (Nodei (Some (mi,ma)) deg treeArray summary)
}))))"
end
context VEBT_internal begin
partial_function (heap_time) vebt_inserti'::"VEBT ⇒VEBTi ⇒ nat ⇒VEBTi Heap" where
"vebt_inserti' t ti x = (case ti of
(Leafi a b) ⇒ (if x=0 then return (Leafi True b) else if x=1
then return (Leafi a True) else return (Leafi a b)) |
(Nodei info deg treeArray summary) ⇒ ( case info of None ⇒
if deg ≤ 1 then
return (Nodei info deg treeArray summary)
else
return (Nodei (Some (x,x)) deg treeArray summary)|
(Some minma) ⇒
( if deg ≤ 1
then return (Nodei info deg treeArray summary)
else (
do{
assert' (is_Node t);
let (info',deg',treeList,summary') =
(case t of (Node info' deg' treeList summary') ⇒
(info', deg', treeList, summary'));
assert'(info= info' ∧ deg = deg');
let (mi', ma') = (the info');
mi <- return (fst minma);
ma <- return (snd minma);
xn <- (if x < mi then return mi else return x);
let xn' = (if x < mi' then mi' else x);
minn <- (if x < mi then return x else return mi);
let minn' = (if x < mi' then x else mi');
l<- lowi xn (deg div 2);
assert' (l = low xn' (deg' div 2));
h <- highi xn (deg div 2);
len ← Array_Time.len treeArray;
if h < len ∧ ¬ (x = mi ∨ x = ma) then do {
assert' (h = high xn' (deg' div 2));
assert'( h < length treeList);
node <- Array_Time.nth treeArray h;
empt <- minNulli node;
assert' (empt = minNull (treeList ! h));
newnode <- vebt_inserti' (treeList ! h) node l;
newarray <- Array_Time.upd h newnode treeArray;
newsummary<-(if empt then
vebt_inserti' summary' summary h
else return summary);
man <- (if xn > ma then return xn else return ma);
return (Nodei (Some (minn, man)) deg newarray newsummary)}
else return (Nodei (Some (mi,ma)) deg treeArray summary)
}))))"
lemmas listI_assn_wrap_insert = listI_assn_reinsert_upd'[
where x="VEBT_Insert.vebt_insert _ _" and A=vebt_assn_raw ]
lemma vebt_inserti'_rf_abstr: "<vebt_assn_raw t ti> vebt_inserti' t ti x <λr. vebt_assn_raw ( vebt_insert t x) r >"
proof(induction t x arbitrary: ti rule: vebt_insert.induct)
case (1 a b x)
then show ?case by (subst vebt_inserti'.simps)(cases ti; sep_auto)
next
case (2 info ts s x)
then show ?case by (subst vebt_inserti'.simps) (cases ti; sep_auto)
next
case (3 info ts s x)
then show ?case by(subst vebt_inserti'.simps) (cases ti; sep_auto)
next
case (4 v treeList summary x)
then show ?case by (subst vebt_inserti'.simps)(cases ti; sep_auto)
next
case (5 mi ma va treeList summary x)
note IH1 = "5.IH"(1)[OF refl refl _ _]
note IH2 = "5.IH"(2)[OF refl refl refl]
show ?case
apply (cases ti)
subgoal
supply [split del] = if_split
apply (subst vebt_inserti'.simps; clarsimp split del: )
apply (assn_simp; intro normalize_rules)
apply (extract_pre_pure dest: extract_pre_list_assn_lengthD)
apply (simp only: fold_if_return distrib_if_bind heap_monad_laws)
apply (clarsimp simp: lowi_def highi_def)
apply (sep_auto simp: lowi_def highi_def)
apply(simp add: low_def)
apply (metis fst_conv)
apply(rule bind_rule)
apply sep_auto
apply (simp cong: if_cong)
apply sep_auto
apply(simp add: high_def)
apply (unwrap_idx "((if x < mi then mi else x) div (2 * 2 ^ (va div 2)))")
apply (sep_auto simp: low_def high_def)
apply (heap_rule IH1)
subgoal
by (simp add: low_def high_def split: if_splits)
subgoal
by (simp add: low_def high_def split: if_splits)
subgoal
by (simp add: low_def high_def split: if_splits)
apply (sep_auto simp: low_def high_def)
apply (heap_rule IH2)
subgoal
by (simp add: low_def high_def split: if_splits)
subgoal
by (simp add: low_def high_def)
subgoal
by (simp add: low_def high_def split: if_splits)
apply (wrap_idx R: listI_assn_wrap_insert)
apply (sep_auto simp: low_def high_def Let_def)
apply (wrap_idx R: listI_assn_wrap_insert)
apply (sep_auto simp: low_def high_def Let_def)+
done
subgoal
by simp
done
qed
lemma TBOUND_minNull: "minNull t ⟹ TBOUND (vebt_inserti' t ti x ) 1"
apply(subst vebt_inserti'.simps)
apply(cases t rule: minNull.cases; simp)
apply TBOUND+
apply (auto split: VEBTi.splits option.splits)
done
lemma TBOUND_vebt_inserti:
defines foo_def: "⋀ t x. foo t x ≡ if minNull t then 1 else 13 * (1+height t)"
shows "TBOUND (vebt_inserti' t ti x) (foo t x)"
proof-
have fooNull:"minNull t ⟹ foo t x = 1" for t x using foo_def by simp
have fooElse: "foo t x ≤ 13* (1+ height t)" for t using foo_def by simp
show ?thesis
apply (induction arbitrary: t ti x rule: vebt_inserti'.fixp_induct)
apply (rule TBOUND_fi'_adm)
apply (rule TBOUND_empty)
apply (rule TBOUND_mono)
apply TBOUND_step+
apply (simp split!: VEBTi.splits VEBT.split option.splits prod.splits if_split)
apply(simp_all add: foo_def height_i_max)
done
qed
lemma vebt_inserti_refines: "refines (vebt_inserti ti x) (vebt_inserti' t ti x)"
apply (induction arbitrary: t ti x rule: vebt_inserti'.fixp_induct)
subgoal using refines_adm[where t = "λ arg. vebt_inserti (snd (fst arg)) (snd arg)"]
by simp
subgoal
by simp
apply(subst vebt_inserti.simps)
apply refines
done
lemma htt_vebt_inserti:
"<vebt_assn_raw t ti> vebt_inserti ti x <λ r. vebt_assn_raw (vebt_insert t x) r>T[ 13 + 13 * height t]"
apply (rule htt_refine[where c = "vebt_inserti' t ti x"])
prefer 2
apply(rule vebt_inserti_refines)
apply (rule httI_TBOUND)
apply(rule vebt_inserti'_rf_abstr)
apply(rule TBOUND_mono)
apply(rule TBOUND_vebt_inserti)
apply simp
done
lemma htt_vebt_inserti_invar_vebt: assumes "invar_vebt t n" shows
"<vebt_assn_raw t ti> vebt_inserti ti x <λ r. vebt_assn_raw (vebt_insert t x) r>T[13 + 13 * (nat ⌈lb n ⌉)]"
by (metis assms heigt_uplog_rel htt_vebt_inserti nat_int)
end
end
Theory VEBT_SuccPredImperative
theory VEBT_SuccPredImperative
imports VEBT_BuildupMemImp VEBT_Succ VEBT_Pred
begin
context begin
interpretation VEBT_internal .
section ‹Imperative Successor›
partial_function (heap_time) vebt_succi::"VEBTi ⇒ nat ⇒ (nat option) Heap" where
"vebt_succi t x = (case t of (Leafi a b) ⇒(if x = 0 then (if b then return (Some 1) else return None)
else return None)|
(Nodei info deg treeArray summary) ⇒ (
case info of None ⇒ return None |
(Some mima) ⇒ ( if deg ≤ 1 then return None else
(if x < fst mima then return (Some (fst mima)) else
if x ≥ snd mima then return None else
do {
l <- lowi x (deg div 2);
h <- highi x (deg div 2);
aktnode <- Array_Time.nth treeArray h;
maxlow <- vebt_maxti aktnode;
if (maxlow ≠ None ∧ (Some l <⇩o maxlow))
then do {
succy <- vebt_succi aktnode l;
return ( Some (2^(deg div 2)) *⇩o Some h +⇩o succy)
}
else do {
succsum <- vebt_succi summary h;
if succsum = None then
return None
else
do{
nextnode <- Array_Time.nth treeArray (the succsum);
minnext <- vebt_minti nextnode;
return (Some (2^(deg div 2)) *⇩o succsum +⇩o minnext)
}
}
})
)))"
end
context VEBT_internal begin
partial_function (heap_time) vebt_succi'::"VEBT ⇒ VEBTi ⇒ nat ⇒ (nat option) Heap" where
"vebt_succi' t ti x = (case ti of (Leafi a b) ⇒(if x = 0 then (if b then return (Some 1) else return None)
else return None)|
(Nodei info deg treeArray summary) ⇒ do { assert'( is_Node t);
let (info',deg',treeList,summary') =
(case t of Node info' deg' treeList summary' ⇒ (info',deg',treeList,summary'));
assert'(info'=info ∧ deg'=deg ∧ is_Node t);
case info of None ⇒ return None |
(Some mima) ⇒ (if deg ≤ 1 then return None else
(if x < fst mima then return (Some (fst mima)) else
if x ≥ snd mima then return None else
do {
l <- lowi x (deg div 2);
h <- highi x (deg div 2);
assert'(l = low x (deg div 2));
assert'(h = high x (deg div 2));
assert'(h < length treeList);
aktnode <- Array_Time.nth treeArray h;
let aktnode' = treeList!h;
maxlow <- vebt_maxti aktnode;
assert' (maxlow = vebt_maxt aktnode');
if (maxlow ≠ None ∧ (Some l <⇩o maxlow))
then do {
succy <- vebt_succi' aktnode' aktnode l;
return ( Some (2^(deg div 2)) *⇩o Some h +⇩o succy)
}
else do {
succsum <- vebt_succi' summary' summary h;
assert'(succsum = None ⟷ vebt_succ summary' h = None);
if succsum = None then do{
return None}
else
do{
nextnode <- Array_Time.nth treeArray (the succsum);
minnext <- vebt_minti nextnode;
return (Some (2^(deg div 2)) *⇩o succsum +⇩o minnext)
}
}
})
)})"
theorem vebt_succi'_rf_abstr:"invar_vebt t n ⟹ <vebt_assn_raw t ti> vebt_succi' t ti x <λr. vebt_assn_raw t ti * ↑(r = vebt_succ t x)>"
proof(induction t x arbitrary: ti n rule: vebt_succ.induct)
case (1 uu b)
then show ?case by(subst vebt_succi'.simps) (cases ti; sep_auto)
next
case (2 uv uw n)
then show ?case by(subst vebt_succi'.simps) (cases ti; sep_auto)
next
case (3 ux uy uz va)
then show ?case by(subst vebt_succi'.simps) (cases ti; sep_auto)
next
case (4 v vc vd ve)
then show ?case by(subst vebt_succi'.simps) (cases ti; sep_auto)
next
case (5 v vg vh vi)
then show ?case by(subst vebt_succi'.simps) (cases ti; sep_auto)
next
case (6 mi ma va treeList summary x)
have setprop: "t ∈ set treeList ⟹ invar_vebt t (n div 2 )" for t using 6(3)
by (cases) simp+
have listlength: "length treeList = 2^(n - n div 2)" using 6(3)
by (cases) simp+
have sumprop: "invar_vebt summary (n - n div 2)" using 6(3)
by (cases) simp+
have xprop [simp]: " ¬ ma ≤ x ⟹ high x (Suc (va div 2)) < length treeList"
by (smt (z3) "6.prems" deg_deg_n div2_Suc_Suc div_le_dividend high_bound_aux listlength mi_ma_2_deg not_le_imp_less order.strict_trans ordered_cancel_comm_monoid_diff_class.add_diff_inverse)
hence xprop' [simp]: " ¬ ma ≤ x ⟹ x div (2 * 2 ^ (va div 2)) < length treeList" unfolding high_def by simp
show ?case
apply (cases ti)
prefer 2
subgoal
apply simp
done
subgoal for x11 x12 x13 x14
supply [split del] = if_split
apply (subst vebt_succi'.simps; clarsimp split del: )
apply (assn_simp; intro normalize_rules)
apply simp
apply(auto split: if_split)
subgoal
apply sep_auto
done
apply sep_auto
using "6.prems" geqmaxNone
apply fastforce
apply sep_auto
apply (extract_pre_pure dest: extract_pre_list_assn_lengthD)
apply (sep_auto simp: lowi_def low_def heap: highi_h)
apply(sep_auto heap: vebt_maxtilist)
apply sep_auto
apply(simp add: high_def low_def)
apply (rewrite in "<⌑>_<_>" list_assn_conv_idx)
apply(rewrite in "<⌑>_<_>" listI_assn_extract[where i="(x div (2 * 2 ^ (va div 2)))"])
apply (smt (z3) "6.prems" atLeastLessThan_iff deg_deg_n div2_Suc_Suc div_le_dividend dual_order.strict_trans2 high_bound_aux high_def le0 le_add_diff_inverse listlength mi_ma_2_deg nat_le_linear power_Suc)
apply (smt (z3) "6.prems" deg_deg_n div2_Suc_Suc div_le_dividend dual_order.strict_trans2 high_bound_aux high_def le_add_diff_inverse listlength mi_ma_2_deg nat_le_linear power_Suc)
apply(sep_auto heap: "6.IH"(1))
apply(simp add: low_def)
apply(simp add: high_def)
apply simp+
apply(rule setprop)
apply simp
subgoal for tree_is x
apply sep_auto
apply (smt (z3) "6.prems" deg_deg_n div2_Suc_Suc div_le_dividend dual_order.strict_trans2 high_bound_aux high_def le_add_diff_inverse less_shift listlength low_def mi_ma_2_deg nat_le_linear option.distinct(1) power_Suc)
apply(rule ent_trans[where Q=" vebt_assn_raw summary x14 * (x13 ↦⇩a tree_is )*
(list_assn vebt_assn_raw treeList tree_is)"])
apply (smt (z3) assn_aci(10) atLeastLessThan_iff entails_def leI less_nat_zero_code listI_assn_extract list_assn_conv_idx star_aci(2) xprop')
apply(rule ent_refl)
done
apply simp
apply sep_auto
apply(sep_auto heap: "6.IH"(2))
apply (simp add: high_def low_def)+
apply (rule sumprop)
apply(sep_auto heap: "6.IH"(2))
apply (simp add: high_def low_def)+
apply (rule sumprop)
apply sep_auto+
apply(simp add: high_def low_def)+
using helpyd listlength sumprop
apply presburger+
apply (sep_auto heap: vebt_mintilist)
using helpyd listlength sumprop
apply presburger
using helpyd listlength sumprop
apply presburger+
apply sep_auto
done
done
qed
lemma TBOUND_vebt_succi:
defines foo_def: "⋀ t x. foo t x ≡ 7 * (1+height t)"
shows "TBOUND (vebt_succi' t ti x) (foo t x)"
apply (induction arbitrary: t ti x rule: vebt_succi'.fixp_induct)
apply (rule TBOUND_fi'_adm)
apply (rule TBOUND_empty)
apply TBOUND
apply(simp add: Let_def split!: VEBTi.splits VEBT.splits prod.splits option.splits if_splits)
apply(simp_all add: foo_def max_idx_list)
done
lemma vebt_succi_refines: "refines (vebt_succi ti x) (vebt_succi' t ti x)"
apply (induction arbitrary: t ti x rule: vebt_succi'.fixp_induct)
subgoal using refines_adm[where t = "λ arg. vebt_succi (snd (fst arg)) (snd arg)"]
by simp
subgoal by simp
subgoal for f t ti x
apply(subst vebt_succi.simps)
apply refines
done
done
lemma htt_vebt_succi: assumes "invar_vebt t n"
shows "<vebt_assn_raw t ti> vebt_succi ti x <λ r. vebt_assn_raw t ti * ↑(r = vebt_succ t x) >T[7 + 7*(nat ⌈lb n⌉)]"
apply (rule htt_refine[where c = "vebt_succi' t ti x"])
prefer 2
apply(rule vebt_succi_refines)
apply (rule httI_TBOUND)
apply(rule vebt_succi'_rf_abstr)
apply(rule assms)
apply(rule TBOUND_mono)
apply(rule TBOUND_vebt_succi)
apply simp
apply(rule Nat.eq_imp_le)
apply (metis assms nat_int heigt_uplog_rel)
done
end
context begin
interpretation VEBT_internal .
partial_function (heap_time) vebt_predi::"VEBTi ⇒ nat ⇒ (nat option) Heap" where
"vebt_predi t x = (case t of (Leafi a b) ⇒(if x ≥ 2then (if b then return (Some 1) else if a then return (Some 0) else return None)
else if x = 1 then (if a then return (Some 0) else return None) else return None)|
(Nodei info deg treeArray summary) ⇒ (
case info of None ⇒ return None |
(Some mima) ⇒ ( if deg ≤ 1 then return None else
(if x > snd mima then return (Some (snd mima)) else
do {
l <- lowi x (deg div 2);
h <- highi x (deg div 2);
aktnode <- Array_Time.nth treeArray h;
minlow <- vebt_minti aktnode;
if (minlow ≠ None ∧ (Some l >⇩o minlow))
then do {
predy <- vebt_predi aktnode l;
return ( Some (2^(deg div 2)) *⇩o Some h +⇩o predy)
}
else do {
predsum <- vebt_predi summary h;
if predsum = None then
if x > fst mima then
return (Some (fst mima))
else
return None
else
do{
nextnode <- Array_Time.nth treeArray (the predsum);
maxnext <- vebt_maxti nextnode;
return (Some (2^(deg div 2)) *⇩o predsum +⇩o maxnext)
}
}
}))))"
end
context VEBT_internal begin
section ‹Imperative Predecessor›
partial_function (heap_time) vebt_predi'::"VEBT ⇒ VEBTi ⇒ nat ⇒ (nat option) Heap" where
"vebt_predi' t ti x = (case ti of (Leafi a b) ⇒(if x ≥ 2then (if b then return (Some 1) else if a then return (Some 0) else return None)
else if x = 1 then (if a then return (Some 0) else return None) else return None)|
(Nodei info deg treeArray summary) ⇒ ( do { assert'( is_Node t);
let (info',deg',treeList,summary') =
(case t of Node info' deg' treeList summary' ⇒ (info',deg',treeList,summary'));
assert'(info'=info ∧ deg'=deg ∧ is_Node t);
case info of None ⇒ return None |
(Some mima) ⇒ ( if deg ≤ 1 then return None else
(if x > snd mima then return (Some (snd mima)) else
do {
l <- lowi x (deg div 2);
h <- highi x (deg div 2);
assert'(l = low x (deg div 2));
assert'(h = high x (deg div 2));
assert'(h < length treeList);
aktnode <- Array_Time.nth treeArray h;
let aktnode' = treeList!h;
minlow <- vebt_minti aktnode;
assert' (minlow = vebt_mint aktnode');
if (minlow ≠ None ∧ (Some l >⇩o minlow))
then do {
predy <- vebt_predi' aktnode' aktnode l;
return ( Some (2^(deg div 2)) *⇩o Some h +⇩o predy)
}
else do {
predsum <- vebt_predi' summary' summary h;
assert'(predsum = None ⟷ vebt_pred summary' h = None);
if predsum = None then
if x > fst mima then
return (Some (fst mima))
else
return None
else
do{
nextnode <- Array_Time.nth treeArray (the predsum);
maxnext <- vebt_maxti nextnode;
return (Some (2^(deg div 2)) *⇩o predsum +⇩o maxnext)
}
}
}))}))"
theorem vebt_pred'_rf_abstr:"invar_vebt t n ⟹ <vebt_assn_raw t ti> vebt_predi' t ti x <λr. vebt_assn_raw t ti * ↑(r = vebt_pred t x)>"
proof(induction t x arbitrary: ti n rule: vebt_pred.induct)
case (1 uu uv)
then show ?case by(subst vebt_predi'.simps) (cases ti; sep_auto)
next
case (2 a uw)
then show ?case by(subst vebt_predi'.simps) (cases ti; sep_auto)
next
case (3 a b va)
then show ?case by(subst vebt_predi'.simps) (cases ti; sep_auto)
next
case (4 uy uz va vb)
then show ?case by(subst vebt_predi'.simps) (cases ti; sep_auto)
next
case (5 v vd ve vf)
then show ?case by(subst vebt_predi'.simps) (cases ti; sep_auto)
next
case (6 v vh vi vj)
then show ?case by(subst vebt_predi'.simps) (cases ti; sep_auto)
next
case (7 mi ma va treeList summary x)
have setprop: "t ∈ set treeList ⟹ invar_vebt t (n div 2 )" for t using 7(3)
by (cases) simp+
have listlength: "length treeList = 2^(n - n div 2)" using 7(3)
by (cases) simp+
have sumprop: "invar_vebt summary (n - n div 2)" using 7(3)
by (cases) simp+
have mimapr: "ma ≥ mi" using 7(3)
by (cases) simp+
show ?case
apply (cases ti)
prefer 2
subgoal
apply simp
done
subgoal
supply [split del] = if_split
apply (subst vebt_predi'.simps; clarsimp split del: )
apply (assn_simp; intro normalize_rules)
apply simp
apply(cases "ma < x")
subgoal
apply simp
apply sep_auto
done
apply simp
apply (extract_pre_pure dest: extract_pre_list_assn_lengthD)
apply(sep_auto simp: highi_def)
apply (sep_auto simp: lowi_def)
apply sep_auto
apply(simp add: low_def)
apply sep_auto
apply(simp add: high_def)
apply sep_auto
apply (smt (z3) "7.prems" deg_deg_n div2_Suc_Suc div_le_dividend high_bound_aux high_def le_add_diff_inverse linorder_neqE_nat listlength mi_ma_2_deg order.strict_trans power_Suc)
apply sep_auto
apply (smt (z3) "7.prems" deg_deg_n div2_Suc_Suc div_le_dividend high_bound_aux high_def le_add_diff_inverse linorder_neqE_nat listlength mi_ma_2_deg order.strict_trans power_Suc)
apply (sep_auto heap: vebt_mintilist)
apply (smt (z3) "7.prems" deg_deg_n div2_Suc_Suc div_le_dividend high_bound_aux high_def le_add_diff_inverse linorder_neqE_nat listlength mi_ma_2_deg order.strict_trans power_Suc)
apply sep_auto
apply (rewrite in "<⌑>_<_>" list_assn_conv_idx)
apply(rewrite in "<⌑>_<_>" listI_assn_extract[where i="(x div (2 * 2 ^ (va div 2)))"])
apply (smt (z3) "7.prems" atLeastLessThan_iff deg_deg_n div2_Suc_Suc div_le_dividend high_bound_aux high_def le0 le_add_diff_inverse linorder_neqE_nat listlength mi_ma_2_deg order.strict_trans power_Suc)
apply (smt (z3) "7.prems" deg_deg_n div2_Suc_Suc div_le_dividend high_bound_aux high_def le_add_diff_inverse linorder_neqE_nat listlength mi_ma_2_deg order.strict_trans power_Suc)
apply (sep_auto heap: "7.IH"(1))
apply(simp add: high_def low_def)+
apply (smt (z3) "7.prems" deg_deg_n div2_Suc_Suc div_le_dividend high_bound_aux high_def le_add_diff_inverse linorder_neqE_nat listlength mi_ma_2_deg order.strict_trans power_Suc)
apply(rule DEADID.rel_refl)
apply (metis greater_shift option.simps(3))
apply(rule setprop)
apply(rule nth_mem)
apply (smt (z3) "7.prems" atLeastLessThan_iff deg_deg_n div2_Suc_Suc div_le_dividend high_bound_aux high_def le0 le_add_diff_inverse linorder_neqE_nat listlength mi_ma_2_deg order.strict_trans power_Suc)
apply simp
subgoal
apply sep_auto
apply (smt (z3) "7.prems" deg_deg_n div2_Suc_Suc div_le_dividend dual_order.strict_trans2 greater_shift high_bound_aux high_def leI le_add_diff_inverse listlength low_def mi_ma_2_deg option.distinct(1) power_Suc)
apply (rule recomp)
apply (smt (z3) "7.prems" atLeastLessThan_iff deg_deg_n div2_Suc_Suc div_le_dividend high_bound_aux high_def le0 le_add_diff_inverse linorder_neqE_nat listlength mi_ma_2_deg order.strict_trans power_Suc)
apply (smt (z3) "7.prems" deg_deg_n div2_Suc_Suc div_le_dividend dual_order.strict_trans2 greater_shift high_bound_aux high_def leI le_add_diff_inverse listlength low_def mi_ma_2_deg option.distinct(1) power_Suc)
apply (rule recomp)
apply (smt (z3) "7.prems" atLeastLessThan_iff deg_deg_n div2_Suc_Suc div_le_dividend high_bound_aux high_def le0 le_add_diff_inverse linorder_neqE_nat listlength mi_ma_2_deg order.strict_trans power_Suc)
done
apply(sep_auto heap: "7.IH"(2))
apply(simp add: high_def low_def)+
apply (smt (z3) "7.prems" atLeastLessThan_iff deg_deg_n div2_Suc_Suc div_le_dividend high_bound_aux high_def le0 le_add_diff_inverse linorder_neqE_nat listlength mi_ma_2_deg order.strict_trans power_Suc)
apply(rule DEADID.rel_refl)
apply (simp add: low_def)
apply(rule sumprop)
apply sep_auto
apply(sep_auto simp: high_def low_def)+
apply (smt (z3) "7.prems" deg_deg_n div2_Suc_Suc div_le_dividend dual_order.strict_trans2 high_bound_aux high_def leI le_add_diff_inverse listlength mi_ma_2_deg power_Suc)
apply (simp add: high_def low_def)
apply (smt (z3) "7.prems" deg_deg_n div2_Suc_Suc div_le_dividend dual_order.strict_trans2 greater.elims(2) high_bound_aux high_def leI le_add_diff_inverse listlength mi_ma_2_deg power_Suc)
apply sep_auto
apply(sep_auto simp: high_def low_def)+
apply presburger
apply (smt (z3) greater.elims(2) high_def low_def power_Suc)
apply (simp add: high_def low_def)
apply sep_auto
subgoal
using helpypredd listlength sumprop apply simp
done
subgoal
using helpypredd listlength sumprop apply simp
done
apply sep_auto
apply(rule cons_pre_rule)
apply(sep_auto heap: vebt_maxti_h)
apply (rewrite in "<⌑>_<_>" list_assn_conv_idx)
apply (rewrite in "<⌑>_<_>" listI_assn_extract[where i="the (vebt_pred summary (x div (2 * 2 ^ (va div 2))))"])
apply (metis atLeastLessThan_iff helpypredd le0 listlength option.sel sumprop)
apply (metis helpypredd listlength option.sel sumprop)
apply (simp add: algebra_simps)
apply(rule cons_pre_rule)
apply(rule ext)
using helpypredd listlength sumprop apply presburger
apply(sep_auto heap: vebt_maxti_h)
apply (rewrite in "<⌑>_<_>" list_assn_conv_idx)
apply (rewrite in "<⌑>_<_>" listI_assn_extract[where i="the (vebt_pred summary (x div (2 * 2 ^ (va div 2))))"])
apply (metis atLeastLessThan_iff helpypredd le0 listlength option.sel sumprop)
apply (metis helpypredd listlength option.sel sumprop)
apply simp
apply(sep_auto heap: vebt_maxti_h)
apply sep_auto
apply (smt (z3) "7.prems" deg_deg_n div2_Suc_Suc div_le_dividend dual_order.strict_trans2 high_bound_aux high_def leI le_add_diff_inverse listlength mi_ma_2_deg option.distinct(1) option.sel power_Suc)
apply (smt (z3) "7.prems" deg_deg_n div2_Suc_Suc div_le_dividend dual_order.strict_trans2 greater.elims(2) high_bound_aux high_def leI le_add_diff_inverse listlength mi_ma_2_deg option.distinct(1) option.sel power_Suc)
apply(rule txe)
using helpypredd listlength sumprop apply presburger
apply (smt (z3) "7.prems" deg_deg_n div2_Suc_Suc div_le_dividend dual_order.strict_trans2 greater.elims(2) high_bound_aux high_def leI le_add_diff_inverse listlength mi_ma_2_deg option.distinct(1) option.sel power_Suc)
apply(rule txe)
using helpypredd listlength sumprop apply presburger
done
done
qed
lemma TBOUND_vebt_predi:
defines foo_def: "⋀ t x. foo t x ≡ 7 * (1+height t)"
shows "TBOUND (vebt_predi' t ti x) (foo t x)"
apply (induction arbitrary: t ti x rule: vebt_predi'.fixp_induct)
apply (rule TBOUND_fi'_adm)
apply (rule TBOUND_empty)
apply TBOUND
apply (simp add: Let_def split!: VEBTi.splits VEBT.splits option.splits prod.splits if_splits)
apply(simp_all add: foo_def max_idx_list)
done
lemma vebt_predi_refines: "refines (vebt_predi ti x) (vebt_predi' t ti x)"
apply (induction arbitrary: t ti x rule: vebt_predi'.fixp_induct)
subgoal using refines_adm[where t = "λ arg. vebt_predi (snd (fst arg)) (snd arg)"]
by simp
subgoal by simp
subgoal for f t ti x
apply(subst vebt_predi.simps)
apply refines
done
done
lemma htt_vebt_predi: assumes "invar_vebt t n"
shows "<vebt_assn_raw t ti> vebt_predi ti x <λ r. vebt_assn_raw t ti * ↑(r = vebt_pred t x) >T[7 + 7*(nat ⌈lb n⌉)]"
apply (rule htt_refine[where c = "vebt_predi' t ti x"])
prefer 2
apply(rule vebt_predi_refines)
apply (rule httI_TBOUND)
apply(rule vebt_pred'_rf_abstr)
apply(rule assms)
apply(rule TBOUND_mono)
apply(rule TBOUND_vebt_predi)
apply simp
apply(rule Nat.eq_imp_le)
apply (metis assms nat_int heigt_uplog_rel)
done
end
end
Theory VEBT_DelImperative
theory VEBT_DelImperative imports VEBT_DeleteCorrectness VEBT_SuccPredImperative
begin
context begin
interpretation VEBT_internal .
section ‹Imperative Delete›
partial_function (heap_time) vebt_deletei::"VEBTi ⇒ nat ⇒ VEBTi Heap" where
"vebt_deletei t x = (case t of (Leafi a b) ⇒ (if x = 0 then return (Leafi False b) else
if x = 1 then return (Leafi a False) else
return (Leafi a b)) |
(Nodei info deg treeArray summary) ⇒ (
if deg ≤ 1 then return (Nodei info deg treeArray summary) else
case info of None ⇒ return (Nodei info deg treeArray summary)|
(Some mima) ⇒ ( if x < fst mima ∨ x > snd mima then return (Nodei info deg treeArray summary)
else if fst mima = x ∧ snd mima = x then return (Nodei None deg treeArray summary)
else do{ xminew <- (if x = fst mima then do {
firstcluster <- vebt_minti summary;
firsttree <- Array_Time.nth treeArray (the firstcluster);
mintft <- vebt_minti firsttree;
let xn = (2^(deg div 2) * (the firstcluster) +
(the mintft) );
return (xn, xn)
}
else return (x, fst mima));
let xnew = fst xminew;
let minew = snd xminew;
h <- highi xnew (deg div 2);
l <- lowi xnew (deg div 2);
aktnode <- Array_Time.nth treeArray h;
aktnode'<-vebt_deletei aktnode l;
treeArray' <- Array_Time.upd h aktnode' treeArray;
miny <- vebt_minti aktnode';
(if (miny = None) then
do{
summary' <-vebt_deletei summary h;
ma <- (if xnew = snd mima then
do{
summax <- vebt_maxti summary';
if summax = None then
return minew
else do{
maxtree <- Array_Time.nth treeArray' (the summax);
mofmtree<- vebt_maxti maxtree;
return (the summax * 2^(deg div 2) +
the mofmtree )
}
}
else return (snd mima));
return (Nodei (Some (minew, ma)) deg treeArray' summary')
} else if xnew = snd mima then
do{
nextree <- Array_Time.nth treeArray' h;
maxnext<- vebt_maxti nextree;
let ma = h * 2^(deg div 2) +
(the maxnext);
return (Nodei (Some ( minew, ma)) deg treeArray' summary)
}
else return (Nodei (Some (minew, snd mima)) deg treeArray' summary) )
})))"
end
context VEBT_internal begin
text ‹Some general lemmas›
lemma midextr:"(P * Q * Q' *R ⟹⇩A X) ⟹ (P * R * Q *Q' ⟹⇩A X)"
by (smt (verit, ccfv_threshold) ab_semigroup_mult_class.mult.commute assn_aci(9) entails_def mod_frame_fwd)
lemma groupy: "A *B * (C * D) ⟹⇩A X ⟹A *B * C * D ⟹⇩A X "
by (simp add: assn_aci(9))
lemma swappa: "B* A* C ⟹⇩A X ⟹A *B * C ⟹⇩A X "
by (simp add: ab_semigroup_mult_class.mult.commute)
lemma mulcomm: "(i::nat) * (2 * 2 ^ (va div 2)) = (2 * 2 ^ (va div 2)) * i"
by simp
text ‹Modified function with ghost variable›
partial_function (heap_time) vebt_deletei'::"VEBT ⇒ VEBTi ⇒ nat ⇒ VEBTi Heap" where
"vebt_deletei' t ti x = (case ti of (Leafi a b) ⇒ (if x = 0 then return (Leafi False b) else
if x = 1 then return (Leafi a False) else
return (Leafi a b)) |
(Nodei info deg treeArray summary) ⇒ (
do { assert'( is_Node t);
let (info',deg',treeList,summary') =
(case t of Node info' deg' treeList summary'
⇒ (info',deg',treeList,summary'));
assert'(info'=info ∧ deg'=deg ∧ is_Node t);
if deg ≤ 1 then return (Nodei info deg treeArray summary) else
case info of None ⇒ return (Nodei info deg treeArray summary)|
(Some mima) ⇒ (
if x < fst mima ∨ x > snd mima then return (Nodei info deg treeArray summary)
else if fst mima = x ∧ snd mima = x then return (Nodei None deg treeArray summary)
else do{ xminew <- (if x = fst mima then do {
firstcluster <- vebt_minti summary;
firsttree <- Array_Time.nth treeArray (the firstcluster);
mintft <- vebt_minti firsttree;
let xn = (2^(deg div 2) * (the firstcluster) +
(the mintft) );
return (xn, xn)
}
else return (x, fst mima));
let xnew = fst xminew;
let xn' =
(if x = fst (the info')
then the (vebt_mint summary') * 2^(deg div 2)
+ the (vebt_mint (treeList ! the (vebt_mint summary')))
else x);
assert' (xnew = xn');
let minew = snd xminew;
assert' (minew = (if x = fst (the info') then xn' else fst (the info')));
h <- highi xnew (deg div 2);
assert' (h = high xnew (deg div 2));
assert'( h < length treeList);
l <- lowi xnew (deg div 2);
assert'(l = low xnew (deg div 2));
aktnode <- Array_Time.nth treeArray h;
aktnode'<-vebt_deletei' (treeList ! h) aktnode l;
treeArray' <- Array_Time.upd h aktnode' treeArray;
let funnode = vebt_delete (treeList ! h) l;
let treeList' = treeList[h:= funnode];
miny <- vebt_minti aktnode';
assert' (miny = vebt_mint funnode);
(if (miny = None) then
do{
summaryi' <-vebt_deletei' summary' summary h;
ma <- (if xnew = snd mima then
do{
summax <- vebt_maxti summaryi';
assert' (summax = vebt_maxt (vebt_delete summary' h));
if summax = None then
return minew
else do{
maxtree <- Array_Time.nth treeArray' (the summax);
mofmtree<- vebt_maxti maxtree;
return (the summax * 2^(deg div 2) +
the mofmtree )
}
}
else return (snd mima));
return (Nodei (Some (minew, ma)) deg treeArray' summaryi')
} else if xnew = snd mima then
do{
nextree <- Array_Time.nth treeArray' h;
maxnext<- vebt_maxti nextree;
assert' (maxnext = vebt_maxt (treeList' ! h));
let ma = h * 2^(deg div 2) +
(the maxnext);
return (Nodei (Some ( minew, ma)) deg treeArray' summary)
}
else return (Nodei (Some (minew, snd mima)) deg treeArray' summary) )
})}))"
theorem deleti'_rf_abstr: "invar_vebt t n ⟹ <vebt_assn_raw t ti> vebt_deletei' t ti x< vebt_assn_raw (vebt_delete t x)>"
proof(induction t x arbitrary: ti n rule: vebt_delete.induct)
case (1 a b)
then show ?case by(subst vebt_deletei'.simps) (cases ti; sep_auto)
next
case (2 a b)
then show ?case by(subst vebt_deletei'.simps) (cases ti; sep_auto)
next
case (3 a b n)
then show ?case by(subst vebt_deletei'.simps) (cases ti; sep_auto)
next
case (4 deg treeList summary uu)
then show ?case by(subst vebt_deletei'.simps) (cases ti; sep_auto)
next
case (5 mi ma treeList summary x)
then show ?case by(subst vebt_deletei'.simps) (cases ti; sep_auto)
next
case (6 mi ma treeList summary x)
then show ?case by(subst vebt_deletei'.simps) (cases ti; sep_auto)
next
case (7 mi ma va treeList summary x)
have setprop: "t ∈ set treeList ⟹ invar_vebt t (n div 2 )" for t using 7(3)
by (cases) simp+
have listlength: "length treeList = 2^(n - n div 2)" using 7(3)
by (cases) simp+
have sumprop: "invar_vebt summary (n - n div 2)" using 7(3)
by (cases) simp+
have mimaxprop: "mi ≤ ma ∧ ma ≤ 2^n" using 7(3)
by cases simp+
hence xbound: "mi ≤ x ⟹ x ≤ ma ⟹ high x (n div 2) ≤ length treeList "
using div_le_mono high_def listlength power_minus_is_div by auto
let ?xn = " the (vebt_mint summary) * 2 ^ (Suc (Suc va) div 2) + the (vebt_mint (treeList ! the (vebt_mint summary)))"
obtain xnew where xndef: "xnew = ?xn" by simp
let ?minn = "?xn"
obtain minew where minewdef: "minew =?minn" by simp
have highboundn:"ma ≠ mi ⟹x≤ ma ⟹high xnew (n div 2 )< length treeList" using xndef
by (smt (z3) "7.prems" deg_deg_n diff_diff_cancel div2_Suc_Suc div_le_dividend high_bound_aux leD le_add_diff_inverse less_imp_diff_less listlength mi_ma_2_deg nested_mint power_Suc)
have highbound: "ma ≠ mi ⟹x≤ ma ⟹high x (n div 2 )< length treeList"
by (smt (z3) "7.prems" deg_deg_n div_le_dividend high_bound_aux le_less_trans listlength mi_ma_2_deg ordered_cancel_comm_monoid_diff_class.add_diff_inverse)
let ?aktnode = "(treeList !
high (2 * 2 ^ (va div 2) * the (vebt_mint summary) + the (vebt_mint (treeList ! the (vebt_mint summary)))) (Suc (va div 2)))"
obtain aktnode where aktnodedef:"ma ≠ mi ⟹x≤ ma ⟹aktnode = ?aktnode"
by meson
let ?newnode = "vebt_delete ?aktnode (low ?xn (Suc (Suc va) div 2))"
obtain newnode where newnodedef:"newnode = ?newnode" by presburger
let ?newlist="treeList[ high (2 * 2 ^ (va div 2) * the (vebt_mint summary) + the (vebt_mint (treeList ! the (vebt_mint summary)))) (Suc (va div 2)) :=
?newnode]"
let ?newlist'="treeList[ high x (Suc (va div 2)) := vebt_delete (treeList ! high x (Suc (va div 2))) (low x (Suc (va div 2)))]"
show ?case
apply(cases ti)
prefer 2
subgoal
apply simp
done
supply [split del] = if_split
apply (subst vebt_deletei'.simps; clarsimp split del: )
apply (assn_simp; intro normalize_rules)
apply simp
apply(cases "x < mi ∨ ma < x")
subgoal
apply simp
apply sep_auto
done
apply simp
apply(cases "mi = x ∧ ma = x")
subgoal
apply simp
apply sep_auto
done
apply (extract_pre_pure dest: extract_pre_list_assn_lengthD)
apply (cases "mi = x ∧ ma = x"; simp)
apply(cases "x = mi")
subgoal
apply simp
apply sep_auto
apply(sep_auto heap: vebt_minti_h)
apply sep_auto
apply (metis "7.prems" listlength mintlistlength option.sel)
apply sep_auto
apply (rewrite in "<⌑>_<_>" list_assn_conv_idx)
apply (rewrite in "<⌑>_<_>" listI_assn_extract[where i="the (vebt_mint summary)"])
apply (metis "7.prems" atLeastLessThan_iff le0 listlength mintlistlength option.sel)
apply (metis "7.prems" listlength mintlistlength option.sel)
apply(sep_auto heap: vebt_minti_h)
apply(rule cons_pre_rule)
apply (rule repack)
apply (metis "7.prems" listlength mintlistlength option.sel)
apply sep_auto
apply (sep_auto heap: highi_h)
apply sep_auto
apply (metis "7.prems" ab_semigroup_mult_class.mult.commute deg_deg_n nested_mint)
apply (sep_auto heap: lowi_h)
apply (metis "7.prems" ab_semigroup_mult_class.mult.commute deg_deg_n div2_Suc_Suc highboundn mimaxprop power_Suc xndef)
apply sep_auto
apply (rewrite in "<⌑>_<_>" list_assn_conv_idx)
apply (rewrite in "<⌑>_<_>" listI_assn_extract[where i=" high (2 * 2 ^ (va div 2) * the (vebt_mint summary) + the (vebt_mint (treeList ! the (vebt_mint summary)))) (Suc (va div 2))"])
apply (metis "7.prems" ab_semigroup_mult_class.mult.commute atLeastLessThan_iff deg_deg_n leI less_nat_zero_code nested_mint)
apply (metis "7.prems" ab_semigroup_mult_class.mult.commute deg_deg_n nested_mint)
apply sep_auto
apply(sep_auto heap: "7.IH"(1))
apply(simp add: algebra_simps)
apply(simp add: algebra_simps)
apply (metis "7.prems" ab_semigroup_mult_class.mult.commute deg_deg_n nested_mint)
apply(rule setprop)
apply (metis "7.prems" ab_semigroup_mult_class.mult.commute deg_deg_n nested_mint nth_mem)
apply sep_auto
apply (metis "7.prems" ab_semigroup_mult_class.mult.commute deg_deg_n nested_mint)
apply(simp add: Let_def)
apply sep_auto
apply(sep_auto heap: vebt_minti_h)
apply(rule cons_pre_rule)
apply(rule big_assn_simp[of "high (2 * 2 ^ (va div 2) * the (vebt_mint summary) + the (vebt_mint (treeList ! the (vebt_mint summary)))) (Suc (va div 2))"
treeList "(low (2 * 2 ^ (va div 2) * the (vebt_mint summary) + the (vebt_mint (treeList ! the (vebt_mint summary)))) (Suc (va div 2)))"
_ _ _ _ summary])
apply (metis "7.prems" ab_semigroup_mult_class.mult.commute deg_deg_n div2_Suc_Suc highboundn mimaxprop power_Suc xndef)
apply(cases "vebt_mint (vebt_delete (treeList !
high (2 * 2 ^ (va div 2) * the (vebt_mint summary) + the (vebt_mint (treeList ! the (vebt_mint summary)))) (Suc (va div 2)))
(low (2 * 2 ^ (va div 2) * the (vebt_mint summary) + the (vebt_mint (treeList ! the (vebt_mint summary)))) (Suc (va div 2)))) = None")
apply simp
subgoal
apply sep_auto
apply(sep_auto heap: "7.IH"(2))
apply(simp add: algebra_simps)+
apply (smt (z3) "7.prems" ab_semigroup_add_class.add.commute ab_semigroup_mult_class.mult.left_commute deg_deg_n nested_mint)
apply(rule DEADID.rel_refl)
apply(rule DEADID.rel_refl)
apply(rule minminNull)
apply (metis ab_semigroup_mult_class.mult.commute)
apply(rule sumprop)
apply(rule bind_rule'[where R="λ r.(let sn = vebt_delete summary (high (2 * 2 ^ (va div 2) *
the (vebt_mint summary) + the (vebt_mint (treeList ! the (vebt_mint summary)))) (Suc (va div 2))) in ( ↑(r = (
if ?xn = ma then let maxs = vebt_maxt sn in if maxs = None then ?xn
else 2 ^ (Suc (Suc va) div 2) * the maxs + the (vebt_maxt (?newlist ! the maxs)) else ma))))"])
apply(cases "2 * 2 ^ (va div 2) * the (vebt_mint summary) + the (vebt_mint (treeList ! the (vebt_mint summary))) = ma")
apply simp+
apply sep_auto
apply(sep_auto heap: vebt_maxti_h)
apply sep_auto
using delete_pres_valid[of summary "n - n div 2"
"(high (2 * 2 ^ (va div 2) * the (vebt_mint summary) + the (vebt_mint (treeList ! the (vebt_mint summary)))) (Suc (va div 2)))"]
maxt_member[of "vebt_delete summary _" "n-n div 2"] member_bound[of "vebt_delete summary _ " _ "n-n div 2"] listlength sumprop
apply (metis both_member_options_equiv_member dele_bmo_cont_corr maxbmo member_bound)
apply sep_auto
apply (rewrite in "<⌑>_<_>" list_assn_conv_idx)
apply (rewrite in "<⌑>_<_>" listI_assn_extract[where i=" the ( vebt_maxt (vebt_delete summary (high (2 * 2 ^ (va div 2) * the (vebt_mint summary)
+ the (vebt_mint (treeList ! the (vebt_mint summary)))) (Suc (va div 2)))))"])
apply (metis atLeastLessThan_iff both_member_options_equiv_member dele_bmo_cont_corr le0 length_list_update listlength maxbmo member_bound option.sel sumprop)
apply (metis both_member_options_equiv_member dele_bmo_cont_corr length_list_update listlength maxbmo member_bound option.sel sumprop)
apply(sep_auto heap: vebt_maxti_h)
apply sep_auto
apply (simp add: ab_semigroup_mult_class.mult.commute)
apply auto[1]
apply(cases " the( vebt_maxt (vebt_delete summary
(high (2 * 2 ^ (va div 2) * the (vebt_mint summary) + the (vebt_mint (treeList ! the (vebt_mint summary)))) (Suc (va div 2))))) < length treeList")
using txe
apply (metis length_list_update option.sel)
apply (metis both_member_options_equiv_member dele_bmo_cont_corr listlength maxbmo member_bound option.sel sumprop)
apply simp
apply sep_auto
apply (metis ab_semigroup_mult_class.mult.commute)
apply sep_auto
apply(simp add: Let_def)
apply(cases " high (the (vebt_mint summary) * (2 * 2 ^ (va div 2)) + the (vebt_mint (treeList ! the (vebt_mint summary)))) (Suc (va div 2)) < length treeList")
apply simp
apply(cases "minNull (vebt_delete (treeList !
high (the (vebt_mint summary) * (2 * 2 ^ (va div 2)) + the (vebt_mint (treeList ! the (vebt_mint summary)))) (Suc (va div 2)))
(low (the (vebt_mint summary) * (2 * 2 ^ (va div 2)) + the (vebt_mint (treeList ! the (vebt_mint summary)))) (Suc (va div 2))))")
subgoal
apply(sep_auto simp: algebra_simps split: if_split)
done
subgoal
apply(auto split: if_split)
apply sep_auto
prefer 2
apply(rule entails_solve_init)
apply (tactic ‹Seplogic_Auto.match_frame_tac (resolve_tac @{context} @{thms ent_refl}) @{context} 1›)
apply simp
apply solve_entails
apply (simp add: ab_semigroup_mult_class.mult.commute)
prefer 3
apply sep_auto
apply (metis ab_semigroup_mult_class.mult.commute minminNull)+
done
subgoal
apply(rule entails_solve_init)
apply simp
done
subgoal
apply(simp add: Let_def)
apply(auto split: if_split)
apply sep_auto
using "7.prems" deg_deg_n nested_mint apply blast
apply(rule entails_solve_init)
apply (tactic ‹Seplogic_Auto.match_frame_tac (resolve_tac @{context} @{thms ent_refl}) @{context} 1›)
apply simp
apply solve_entails
apply (simp add: ab_semigroup_mult_class.mult.commute)
using "7.prems" deg_deg_n nested_mint apply blast
apply sep_auto
using "7.prems" deg_deg_n nested_mint apply blast
using "7.prems" deg_deg_n nested_mint apply blast
apply(rule entails_solve_init)
apply (tactic ‹Seplogic_Auto.match_frame_tac (resolve_tac @{context} @{thms ent_refl}) @{context} 1›)
apply simp
apply solve_entails
apply (simp add: ab_semigroup_mult_class.mult.commute)
using "7.prems" deg_deg_n nested_mint apply blast
done
subgoal
apply(simp add: Let_def)
apply(auto split: if_split)
apply sep_auto
apply(rule entails_solve_init)
apply (tactic ‹Seplogic_Auto.match_frame_tac (resolve_tac @{context} @{thms ent_refl}) @{context} 1›)
apply simp
apply solve_entails
apply (simp add: ab_semigroup_mult_class.mult.commute)
apply (simp add: ab_semigroup_mult_class.mult.commute minminNull)
done
using "7.prems" deg_deg_n nested_mint apply blast
done
apply(auto split: if_split)
apply sep_auto
apply (metis "7.prems" ab_semigroup_mult_class.mult.commute deg_deg_n nested_mint)
apply (rewrite in "<⌑>_<_>" list_assn_conv_idx)
apply (rewrite in "<⌑>_<_>" listI_assn_extract[where i=" high (2 * 2 ^ (va div 2) * the (vebt_mint summary) + the (vebt_mint (treeList ! the (vebt_mint summary)))) (Suc (va div 2))"])
apply (metis "7.prems" highboundn ab_semigroup_mult_class.mult.commute atLeastLessThan_iff deg_deg_n div2_Suc_Suc leI length_list_update less_nat_zero_code power_Suc xndef)
apply (metis "7.prems" ab_semigroup_mult_class.mult.commute deg_deg_n length_list_update nested_mint)
apply(sep_auto)
apply(sep_auto heap: vebt_maxti_h)
apply sep_auto
apply (simp add: Let_def)
apply(auto split: if_split)
apply(simp add: Let_def)
apply(auto split: if_split)
apply (metis minNullmin mulcomm option.simps(3))
apply (metis minNullmin mulcomm option.distinct(1))
subgoal
apply sep_auto
apply (simp add: ab_semigroup_mult_class.mult.commute)
apply(rule listI_assn_reinsert_upd[ where x = "_ ! _"] )
apply(rule midextr)
apply(rule midextr)
apply(rule groupy)
apply(rule ent_refl)
apply (metis ab_semigroup_mult_class.mult.commute length_list_update)
apply (metis ab_semigroup_mult_class.mult.commute atLeastLessThan_iff le0)
apply(fr_rot 1)
apply(rule swappa)
apply(simp add: mulcomm)
apply(simp add: listI_assn_conv)
apply(rule ent_refl)
done
using "7.prems" deg_deg_n nested_mint
apply blast
apply sep_auto
apply(simp add: Let_def)
apply(auto split: if_split)
apply (simp add: minNullmin mulcomm)
apply (simp add: ab_semigroup_mult_class.mult.commute minNullmin)
apply sep_auto
apply sep_auto
using "7.prems" deg_deg_n nested_mint apply blast
apply(rule swappa)
apply(simp add: mulcomm)
apply(rule ent_refl)
done
apply simp
apply(sep_auto heap: highi_h)
apply (metis "7.prems" deg_deg_n div2_Suc_Suc highbound leI linorder_neqE_nat)
apply(sep_auto heap: lowi_h)
apply (metis "7.prems" deg_deg_n div2_Suc_Suc highbound leI linorder_neqE_nat)
apply sep_auto
apply (rewrite in "<⌑>_<_>" list_assn_conv_idx)
apply (rewrite in "<⌑>_<_>" listI_assn_extract[where i=" high x (Suc (va div 2))"])
apply (metis "7.prems" atLeastLessThan_iff deg_deg_n div2_Suc_Suc highbound leI le_neq_implies_less less_nat_zero_code)
apply (metis "7.prems" antisym_conv2 deg_deg_n div2_Suc_Suc highbound not_le_imp_less)
apply(sep_auto heap: "7.IH"(1))
apply (metis "7.prems" antisym_conv2 deg_deg_n div2_Suc_Suc highbound not_le_imp_less)
apply(rule setprop)
apply (metis "7.prems" antisym_conv2 deg_deg_n div2_Suc_Suc highbound not_le_imp_less nth_mem)
apply sep_auto
apply (metis "7.prems" deg_deg_n div2_Suc_Suc highbound not_le_imp_less order.not_eq_order_implies_strict)
apply(sep_auto)
apply(sep_auto heap: vebt_minti_h)
apply(rule bind_rule)
apply(rule assert'_rule)
apply (meson mod_pure_star_dist mod_starE)
apply(rule cons_pre_rule)
apply(rule big_assn_simp'[])
apply (metis "7.prems" deg_deg_n div2_Suc_Suc highbound leI le_neq_implies_less) apply auto[1]
apply(cases "vebt_mint (vebt_delete (treeList ! high x (Suc (va div 2))) (low x (Suc (va div 2))))")
apply simp
subgoal
apply sep_auto
apply(sep_auto heap: "7.IH"(2))
apply (metis "7.prems" deg_deg_n div2_Suc_Suc highbound leI le_neq_implies_less)
apply simp+
apply(simp add: minminNull)
apply(rule sumprop)
apply(rule bind_rule'[where R="λ r.(let sn = vebt_delete summary (high x (Suc (va div 2))) in ( ↑(r = (
if x = ma then let maxs = vebt_maxt sn in if maxs = None then mi
else 2 ^ (Suc (Suc va) div 2) * the maxs + the (vebt_maxt (?newlist' ! the maxs)) else ma))))"])
apply(cases "x = ma")
apply simp
apply(sep_auto)
apply(sep_auto heap: vebt_maxti_h)
apply(cases "vebt_maxt (vebt_delete summary (high ma (Suc (va div 2))))")
apply simp
apply sep_auto
apply simp
apply sep_auto
apply (metis both_member_options_equiv_member dele_bmo_cont_corr listlength maxbmo member_bound sumprop)
apply (rewrite in "<⌑>_<_>" list_assn_conv_idx)
apply (rewrite in "<⌑>_<_>" listI_assn_extract[where i="the ( vebt_maxt (vebt_delete summary (high ma (Suc (va div 2)))))"])
apply (metis atLeastLessThan_iff both_member_options_equiv_member dele_bmo_cont_corr le0 length_list_update listlength maxbmo member_bound option.sel sumprop)
apply (metis both_member_options_equiv_member dele_bmo_cont_corr length_list_update listlength maxbmo member_bound option.sel sumprop)
apply sep_auto
apply(sep_auto heap: vebt_maxti_h)
apply sep_auto
apply (smt (verit, ccfv_SIG) ab_semigroup_mult_class.mult.commute ab_semigroup_mult_class.mult.left_commute atLeastLessThan_empty_iff2 atLeastLessThan_iff both_member_options_equiv_member deg_deg_n dele_bmo_cont_corr div2_Suc_Suc div_by_Suc_0 div_mult_self1_is_m div_mult_self_is_m empty_iff ent_refl le0 le_neq_implies_less length_list_update listI_assn_extract list_assn_conv_idx listlength maxbmo member_bound mimaxprop numeral_2_eq_2 option.collapse option.distinct(1) sumprop zero_less_Suc)
apply simp
apply sep_auto
apply sep_auto
apply(simp add: Let_def)
apply(cases "high ma (Suc (va div 2)) < length treeList")
apply simp
apply(simp add: Let_def)
apply(cases "high ma (Suc (va div 2)) < length treeList")
apply simp
apply(cases "minNull (vebt_delete (treeList ! high ma (Suc (va div 2))) (low ma (Suc (va div 2))))")
apply simp
apply(simp add: Let_def)
apply sep_auto
apply simp
apply sep_auto
apply (meson minminNull)+
apply simp
apply(auto split: if_split)
apply (metis "7.prems" deg_deg_n div2_Suc_Suc highbound le_refl)
apply sep_auto
apply (metis "7.prems" deg_deg_n div2_Suc_Suc highbound le_refl)
apply (metis "7.prems" deg_deg_n div2_Suc_Suc highbound le_refl)
apply(simp add: Let_def)
apply(auto split: if_split)
apply(simp add: Let_def)
apply(auto split: if_split)
apply sep_auto+
apply (meson minminNull)
apply sep_auto
apply (metis "7.prems" deg_deg_n div2_Suc_Suc highbound linorder_neqE_nat not_le_imp_less)
done
apply simp
apply(auto split: if_split)
apply sep_auto
apply (metis "7.prems" deg_deg_n div2_Suc_Suc dual_order.refl highbound)
apply (rewrite in "<⌑>_<_>" list_assn_conv_idx)
apply (rewrite in "<⌑>_<_>" listI_assn_extract[where i="high ma (Suc (va div 2))"])
apply (metis "7.prems" atLeastLessThan_iff deg_deg_n div2_Suc_Suc highbound le0 le_refl length_list_update)
apply (metis "7.prems" deg_deg_n div2_Suc_Suc highbound le_refl length_list_update)
apply sep_auto
apply(sep_auto heap: vebt_maxti_h)
apply sep_auto
apply(simp add: Let_def)
apply(auto split: if_split)
apply(simp add: Let_def)
apply(auto split: if_split)
apply(simp add: Let_def)
subgoal
apply sep_auto
apply (metis minNullmin option.distinct)+
done
apply sep_auto
apply(rule ent_trans)
apply(rule tcd[where treeList'= treeList])
apply blast+
apply(rule swappa)
apply(rule ent_refl)
apply sep_auto
apply (metis "7.prems" deg_deg_n div2_Suc_Suc highbound le_refl)
apply (metis "7.prems" deg_deg_n div2_Suc_Suc dual_order.refl highbound)
apply sep_auto
apply(simp add: Let_def)
apply(auto split: if_split)
apply(simp add: Let_def)
apply(auto split: if_split)
apply sep_auto
apply (metis minNullmin option.distinct(1))
apply sep_auto+
done
qed
lemma TBOUND_vebt_deletei:
defines foo_def: "⋀ t x. foo t x ≡ if minNull (vebt_delete t x) then 1 else 20 * (1+height t)"
shows "TBOUND (vebt_deletei' t ti x) (foo t x)"
proof-
have fooNull:"minNull (vebt_delete t x) ⟹ foo t x = 1" for t x using foo_def by simp
have fooElse: "foo t x ≤ 20* (1+ height t)" for t using foo_def by simp
have succ0foo: "Suc 0 ≤ foo t x" for t x unfolding foo_def by simp
have fooNull': "vebt_mint (vebt_delete t x) = None ⟹ foo t x = 1" for t x
by (simp add: fooNull minminNull)
have fooNull'': "vebt_maxt (vebt_delete t x) = None ⟹ foo t x = 1" for t x
by (metis fooNull fooNull' vebt_maxt.elims minNull.simps(4) vebt_mint.simps(1) option.simps(3))
have minNotMaxDel: "x12a ≥ 2 ⟹ c ≠ d ⟹
¬ minNull (vebt_delete (Node (Some (c, d)) x12a x13 x14) y )" for x12a x13 x14 c d y
apply(cases "( (Node (Some (c, d)) x12a x13 x14), y )" rule: vebt_delete.cases; simp)
apply(auto simp add: Let_def)
done
have twentyheight:" i< length x13 ⟹n * height (x13 !i) ≤ m + n * max (height x14) (Max (height ` set x13))" for i x13 x14 n m
by (meson height_i_max mult_le_mono2 trans_le_add2)
have summheight:"n * height x14 ≤ m + n * max (height x14) (Max (height ` set x13))" for x14 x13 m n
apply(simp add: max_def)
apply (meson mult_le_mono2 trans_le_add2)
done
show ?thesis
apply (induction arbitrary: t ti x rule: vebt_deletei'.fixp_induct)
apply (rule TBOUND_fi'_adm)
apply (rule TBOUND_empty)
apply TBOUND
apply(simp add: Let_def eq_commute[of "Suc 0" "_" ] succ0foo fooNull' fooNull''
split!: VEBT.splits VEBTi.splits option.splits prod.splits )
apply(all ‹(intro allI impI conjI)?›)
apply(all ‹(clarify; simp only: succ0foo; fail)?›)
apply(simp_all add: foo_def minNotMaxDel twentyheight summheight not_less)
done
qed
lemma vebt_deletei_refines: "refines (vebt_deletei ti x) (vebt_deletei' t ti x)"
apply (induction arbitrary: t ti x rule: vebt_deletei'.fixp_induct)
subgoal
using refines_adm[where t = "λ arg. vebt_deletei (snd (fst arg)) (snd arg)"]
by simp
subgoal by simp
subgoal for f t ti x
apply(subst vebt_deletei.simps)
apply refines
done
done
lemma htt_vebt_deletei: assumes "invar_vebt t n"
shows "<vebt_assn_raw t ti> vebt_deletei ti x <λ r. vebt_assn_raw (vebt_delete t x) r >T[20 + 20*(nat ⌈lb n⌉)]"
apply (rule htt_refine[where c = "vebt_deletei' t ti x"])
prefer 2
apply(rule vebt_deletei_refines)
apply (rule httI_TBOUND)
apply(rule deleti'_rf_abstr)
apply(rule assms)
apply(rule TBOUND_mono)
apply(rule TBOUND_vebt_deletei)
apply (auto simp add: if_split)
apply(metis assms eq_imp_le heigt_uplog_rel int_eq_iff)
done
end
end
Theory VEBT_Intf_Imperative
section ‹Imperative Interface›
theory VEBT_Intf_Imperative
imports
VEBT_Definitions
VEBT_Uniqueness
VEBT_Member
VEBT_Insert VEBT_InsertCorrectness
VEBT_MinMax
VEBT_Pred VEBT_Succ
VEBT_Delete VEBT_DeleteCorrectness
VEBT_Bounds
VEBT_DeleteBounds
VEBT_Space
VEBT_Intf_Functional
VEBT_List_Assn
VEBT_BuildupMemImp
VEBT_SuccPredImperative
VEBT_DelImperative
begin
subsection ‹Code Export›
context begin
interpretation VEBT_internal .
lemmas [code] = replicatei.simps vebt_memberi.simps highi_def lowi_def vebt_inserti.simps
minNulli.simps vebt_succi.simps vebt_predi.simps vebt_deletei.simps
greater.simps
end
export_code
vebt_buildupi
vebt_memberi
vebt_inserti
vebt_maxti vebt_minti
vebt_predi vebt_succi
vebt_deletei
checking SML_imp
subsection ‹Interface›
definition vebt_assn::"nat ⇒ nat set ⇒ VEBTi ⇒ assn" where
"vebt_assn n s ti ≡ ∃⇩A t. vebt_assn_raw t ti * ↑(s = set_vebt t ∧ invar_vebt t n)"
subsubsection ‹Buildup›
context begin
interpretation VEBT_internal .
interpretation vebt_inst for n .
lemma vebt_buildupi_rule_basic[sep_heap_rules]: "n > 0 ⟹ <emp> vebt_buildupi n <λ r. vebt_assn n {} r >"
unfolding vebt_assn_def
apply(rule post_exI_rule[where x = "vebt_buildup n"])
using builupicorr[of n] invar_vebt_buildup[of n] set_vebt_buildup[of n]
apply simp
done
lemma vebt_buildupi_rule: "<↑ (n > 0)> vebt_buildupi n <λ r. vebt_assn n {} r > T[10 * 2^n]"
unfolding vebt_assn_def htt_def
apply rule
apply(rule post_exI_rule[where x = "vebt_buildup n"])
using vebt_buildupi_rule[of n] invar_vebt_buildup[of n] set_vebt_buildup[of n]
unfolding htt_def
apply simp
using TBOUND_buildupi[of n] unfolding TBOUND_def
apply simp
done
subsubsection ‹Member›
lemma vebt_memberi_rule: "<vebt_assn n s ti> vebt_memberi ti x <λ r. vebt_assn n s ti * ↑(r = (x ∈ s))>T[5 + 5 * (nat ⌈lb n ⌉)]"
unfolding vebt_assn_def
apply(rule norm_pre_ex_rule_htt)
apply(clarsimp simp: norm_pre_pure_iff_htt)
apply(rule htt_cons_rule[OF htt_vebt_memberi_invar_vebt])
apply assumption
apply simp
apply (sep_auto simp: member_correct)
apply simp
done
subsubsection ‹Insert›
lemma vebt_inserti_rule: "x < 2^n ⟹ <vebt_assn n s ti> vebt_inserti ti x <λ r. vebt_assn n (s ∪ {x}) r >T[13 + 13 * (nat ⌈lb n ⌉)]"
apply(sep_auto simp: norm_pre_pure_iff_htt)
unfolding vebt_assn_def
apply(rule norm_pre_ex_rule_htt)
apply(clarsimp simp: norm_pre_pure_iff_htt)
apply(rule htt_cons_rule[OF htt_vebt_inserti_invar_vebt])
apply assumption
apply simp
apply sep_auto
apply (auto simp add: insert_correct)
apply (simp add: valid_insert_both_member_options_add set_vebt_def)
apply (metis UnCI insert_correct)
apply (metis UnE insert_correct singletonD)
using valid_pres_insert by presburger
subsubsection ‹Maximum›
lemma vebt_maxti_rule: "<vebt_assn n s ti> vebt_maxti ti <λ r. vebt_assn n s ti * ↑( r = Some y ⟷ max_in_set s y)>T[1]"
unfolding vebt_assn_def
apply(rule norm_pre_ex_rule_htt)
apply(clarsimp simp: norm_pre_pure_iff_htt)
apply(rule htt_cons_rule[OF vebt_maxti_hT])
apply(rule ent_refl)
apply (sep_auto simp: set_vebt_maxt)
by simp
subsubsection ‹Minimum›
lemma vebt_minti_rule: "<vebt_assn n s ti> vebt_minti ti <λ r. vebt_assn n s ti * ↑( r = Some y ⟷ min_in_set s y)>T[1]"
unfolding vebt_assn_def
apply(rule norm_pre_ex_rule_htt)
apply(clarsimp simp: norm_pre_pure_iff_htt)
apply(rule htt_cons_rule[OF vebt_minti_hT])
apply(rule ent_refl)
apply (sep_auto simp: set_vebt_mint)
by auto
subsubsection ‹Successor›
lemma vebt_succi_rule: "<vebt_assn n s ti> vebt_succi ti x <λ r. vebt_assn n s ti * ↑( r = Some y ⟷ is_succ_in_set s x y)>T[7 + 7 * (nat ⌈lb n ⌉)]"
unfolding vebt_assn_def
apply(rule norm_pre_ex_rule_htt)
apply(clarsimp simp: norm_pre_pure_iff_htt)
apply(rule htt_cons_rule[OF htt_vebt_succi])
apply assumption
apply simp
apply (sep_auto simp: set_vebt_succ)
apply simp
done
subsubsection ‹Predecessor›
lemma vebt_predi_rule: "<vebt_assn n s ti> vebt_predi ti x <λ r. vebt_assn n s ti * ↑( r = Some y ⟷ is_pred_in_set s x y)>T[7 + 7 * (nat ⌈lb n ⌉)]"
unfolding vebt_assn_def
apply(rule norm_pre_ex_rule_htt)
apply(clarsimp simp: norm_pre_pure_iff_htt)
apply(rule htt_cons_rule[OF htt_vebt_predi])
apply assumption
apply simp
apply (sep_auto simp: set_vebt_pred)
apply simp
done
subsubsection ‹Delete›
lemma vebt_deletei_rule: "<vebt_assn n s ti > vebt_deletei ti x <λ r. vebt_assn n (s - {x}) r >T[20 + 20 * (nat ⌈lb n ⌉)]"
unfolding vebt_assn_def
apply(rule norm_pre_ex_rule_htt)
apply(clarsimp simp: norm_pre_pure_iff_htt)
apply(rule htt_cons_rule[OF htt_vebt_deletei])
apply assumption
apply simp
apply sep_auto
apply (auto simp add: set_vebt_delete invar_vebt_delete)
done
subsection ‹Setup of VCG›
lemmas vebt_heap_rules[THEN htt_htD,sep_heap_rules] =
vebt_buildupi_rule
vebt_memberi_rule
vebt_inserti_rule
vebt_maxti_rule
vebt_minti_rule
vebt_succi_rule
vebt_predi_rule
vebt_deletei_rule
end
end
Theory VEBT_Example
section ‹Interface Usage Example›
theory VEBT_Example
imports VEBT_Intf_Imperative VEBT_Example_Setup
begin
subsection ‹Test Program›
definition "test n xs ys ≡ do {
t ← vebt_buildupi n;
t ← mfold (λx s. vebt_inserti s x) (0#xs) t;
let f = (λx. if⇩m vebt_memberi t x then return x else the $⇩m (vebt_predi t x));
mmap f ys
}"
subsection ‹Correctness without Time›
text ‹The non-time part of our datastructure is fully integrated into sep-auto›
lemma fold_list_rl[sep_heap_rules]: "∀x∈set xs. x<2^n ⟹ hoare_triple
(vebt_assn n s t)
(mfold (λx s. vebt_inserti s x) xs t)
(λt'. vebt_assn n (s ∪ set xs) t')"
proof (induction xs arbitrary: s t)
case Nil
then show ?case by sep_auto
next
case (Cons a xs)
note Cons.IH[sep_heap_rules]
show ?case using Cons.prems
by sep_auto
qed
lemma test_hoare: "⟦∀x∈set xs. x<2^n; n>0⟧ ⟹
<emp> (test n xs ys) <λr. ↑(r = map (λy. (GREATEST y'. y'∈insert 0 (set xs) ∧ y'≤y)) ys) >⇩t "
unfolding test_def
supply R = mmap_pure_aux[where f="(λy. (GREATEST y'. y'∈insert 0 (set xs) ∧ y'≤y))"]
apply (sep_auto decon: R)
subgoal
by (metis (mono_tags, lifting) GreatestI_ex_nat zero_le_numeral)
subgoal
by (metis (no_types, lifting) Greatest_equality le_eq_less_or_eq)
apply sep_auto
subgoal
apply (auto simp: is_pred_in_set_def)
subgoal
by (smt (z3) GreatestI_nat le_neq_implies_less less_eq_nat.simps(1))
subgoal
by (smt (z3) GreatestI_nat mult.right_neutral nat_less_le power_eq_0_iff power_mono_iff)
subgoal
by (metis (no_types, lifting) Greatest_le_nat less_imp_le)
done
apply sep_auto
done
subsection ‹Time Bound Reasoning›
text ‹
We use some ad-hoc reasoning to also show the time-bound of our test program.
A generalization of such methods, or the integration of this entry into existing
reasoning frameworks with time is left to future work.
›
lemma insert_time_pure[cond_TBOUND]:"a < 2^n ⟹
§vebt_assn n S ti§ TBOUND (vebt_inserti ti a) (13 + 13 * nat ⌈log 2 (real n)⌉)"
by(rule htt_elim, rule vebt_inserti_rule, simp)
lemma member_time_pure[cond_TBOUND]:"§vebt_assn n S ti§ TBOUND (vebt_memberi ti a) (5 + 5 * nat ⌈log 2 (real n)⌉)"
by(rule htt_elim, rule vebt_memberi_rule)
lemma pred_time_pure[cond_TBOUND]:"§vebt_assn n S ti§ TBOUND (vebt_predi ti a) (7 + 7 * nat ⌈log 2 (real n)⌉)"
by(rule htt_elim, rule vebt_predi_rule)
lemma TBOUND_mfold[cond_TBOUND]:"
(⋀ x. x ∈ set xs ⟹ x < 2^n) ⟹
§ vebt_assn n S ti § TBOUND (mfold (λx s. vebt_inserti s x) xs ti) (length xs * (13 + 13 * nat ⌈log 2 n ⌉) + 1)"
apply(induction xs arbitrary: ti S)
apply(subst mfold.simps)
apply(cond_TBOUND, simp)
apply sep_auto
subgoal for a xs ti S
apply(rule cond_TBOUND_mono[where b = "(13 + 13 * nat ⌈log 2 (real n)⌉) + (length xs * (13 + 13 * nat ⌈log 2 (real n)⌉) + 1)"])
apply(rule cond_TBOUND, auto|(rule vebt_heap_rules(3), auto))+
done
done
lemma TBOUND_mmap[cond_TBOUND]:
defines b_def: "b ys n ≡ 1 + length ys * ( 5 + 5 * nat ⌈log 2 (real n)⌉ + 9 + 7 * nat ⌈log 2 (real n)⌉)"
shows "§ vebt_assn n S ti § TBOUND
(mmap (λx. if⇩m vebt_memberi ti x then return x
else vebt_predi ti x ⤜ (λx. return (the x))) ys) (b ys n)"
apply(induction ys arbitrary:)
apply(subst mmap.simps)
subgoal
unfolding b_def
apply(rule cond_TBOUND_mono[where b = 1], rule cond_TBOUND_return, simp)
done
apply sep_auto
subgoal for a ys
apply(rule cond_TBOUND_mono[
where b = "((5 + 5 * nat ⌈log 2 (real n)⌉) + max 1 ((7 + 7 * nat ⌈log 2 (real n)⌉) + 1))
+(b ys n + 1)"])
apply(rule cond_TBOUND_bind[where Q = "λ r. vebt_assn n S ti"])
apply(rule cond_TBOUND | rule mmap_pres | sep_auto | rule cond_TBOUND_cons)+
unfolding b_def
apply simp
done
done
lemma TBOUND_test[cond_TBOUND]: "⟦∀x∈set xs. x<2^n; n>0 ⟧ ⟹
§ ↑ (n> 0) § TBOUND (test n xs ys) (10 * 2^n + (
( length (0#xs) * (13 + 13 * nat ⌈log 2 n ⌉) + 1) +
(1 + length ys * ( 5 + 5 * nat ⌈log 2 (real n)⌉ + 9 + 7 * nat ⌈log 2 (real n)⌉))))"
unfolding test_def
apply(cond_TBOUND| rule htt_elim[OF vebt_buildupi_rule] | sep_auto)+
done
lemma test_hoare_with_time: "⟦∀x∈set xs. x<2^n; n>0⟧ ⟹
<emp> (test n xs ys) <λr. ↑(r = map (λy. (GREATEST y'. y'∈insert 0 (set xs) ∧ y'≤y)) ys) * true >
T[10 * 2 ^ n +
(length (0 # xs) * (13 + 13 * nat ⌈log 2 (real n)⌉) + 1 +
(1 + length ys * (5 + 5 * nat ⌈log 2 (real n)⌉ + 9 + 7 * nat ⌈log 2 (real n)⌉)))]"
apply(rule htt_intro, rule test_hoare, simp+)
apply(rule cond_TBOUND_mono, rule cond_TBOUND_cons)
defer
apply(rule TBOUND_test, simp+)
done
end